Как да запазите и използвате вашите VBA макроси във всички работни книги в Excel?

В някои случаи може да се наложи да използвате един VBA макрос няколко пъти в бъдеще. възможно ли е да запишете по някакъв начин VBA модула във всеки нов документ така че ще бъде наличен във всички работни книги? Отговорът е да. В този урок ще ви представим лесен начин за постигане на вашата цел.

Запазете и използвайте VBA кода във всички работни книги

Например искате да използвате кода на VBA, за да преобразувайте числа в английски думи намлява запишете модула VBA във всички работни книги в случай, че искате да използвате кода на VBA в бъдеще. Моля, направете следното.

1. Натисни Alt + F11 клавиши в Excel и отваря Microsoft Visual Basic за приложения прозорец.

2. кликване Поставете > Модули и поставете следния макрос в прозореца на модула.

VBA код: Преобразувайте числа в думи

Function NumberstoWords(ByVal MyNumber)
'Update by Extendoffice
Dim xStr As String
Dim xFNum As Integer
Dim xStrPoint
Dim xStrNumber
Dim xPoint As String
Dim xNumber As String
Dim xP() As Variant
Dim xDP
Dim xCnt As Integer
Dim xResult, xT As String
Dim xLen As Integer
On Error Resume Next
xP = Array("", "Thousand ", "Million ", "Billion ", "Trillion ", " ", " ", " ", " ")
xNumber = Trim(Str(MyNumber))
xDP = InStr(xNumber, ".")
xPoint = ""
xStrNumber = ""
If xDP > 0 Then
xPoint = " point "
xStr = Mid(xNumber, xDP + 1)
xStrPoint = Left(xStr, Len(xNumber) - xDP)
For xFNum = 1 To Len(xStrPoint)
xStr = Mid(xStrPoint, xFNum, 1)
xPoint = xPoint & GetDigits(xStr) & " "
Next xFNum
xNumber = Trim(Left(xNumber, xDP - 1))
End If
xCnt = 0
xResult = ""
xT = ""
xLen = 0
xLen = Int(Len(Str(xNumber)) / 3)
If (Len(Str(xNumber)) Mod 3) = 0 Then xLen = xLen - 1
Do While xNumber <> ""
If xLen = xCnt Then
xT = GetHundredsDigits(Right(xNumber, 3), False)
Else
If xCnt = 0 Then
xT = GetHundredsDigits(Right(xNumber, 3), True)
Else
xT = GetHundredsDigits(Right(xNumber, 3), False)
End If
End If
If xT <> "" Then
xResult = xT & xP(xCnt) & xResult
End If
If Len(xNumber) > 3 Then
xNumber = Left(xNumber, Len(xNumber) - 3)
Else
xNumber = ""
End If
xCnt = xCnt + 1
Loop
xResult = xResult & xPoint
NumberstoWords = xResult
End Function
Function GetHundredsDigits(xHDgt, xB As Boolean)
Dim xRStr As String
Dim xStrNum As String
Dim xStr As String
Dim xI As Integer
Dim xBB As Boolean
xStrNum = xHDgt
xRStr = ""
On Error Resume Next
xBB = True
If Val(xStrNum) = 0 Then Exit Function
xStrNum = Right("000" & xStrNum, 3)
xStr = Mid(xStrNum, 1, 1)
If xStr <> "0" Then
xRStr = GetDigits(Mid(xStrNum, 1, 1)) & "Hundred "
Else
If xB Then
xRStr = "and "
xBB = False
Else
xRStr = " "
xBB = False
End If
End If
If Mid(xStrNum, 2, 2) <> "00" Then
xRStr = xRStr & GetTenDigits(Mid(xStrNum, 2, 2), xBB)
End If
GetHundredsDigits = xRStr
End Function
Function GetTenDigits(xTDgt, xB As Boolean)
Dim xStr As String
Dim xI As Integer
Dim xArr_1() As Variant
Dim xArr_2() As Variant
Dim xT As Boolean
xArr_1 = Array("Ten ", "Eleven ", "Twelve ", "Thirteen ", "Fourteen ", "Fifteen ", "Sixteen ", "Seventeen ", "Eighteen ", "Nineteen ")
xArr_2 = Array("", "", "Twenty ", "Thirty ", "Forty ", "Fifty ", "Sixty ", "Seventy ", "Eighty ", "Ninety ")
xStr = ""
xT = True
On Error Resume Next
If Val(Left(xTDgt, 1)) = 1 Then
xI = Val(Right(xTDgt, 1))
If xB Then xStr = "and "
xStr = xStr & xArr_1(xI)
Else
xI = Val(Left(xTDgt, 1))
If Val(Left(xTDgt, 1)) > 1 Then
If xB Then xStr = "and "
xStr = xStr & xArr_2(Val(Left(xTDgt, 1)))
xT = False
End If
If xStr = "" Then
If xB Then
xStr = "and "
End If
End If
If Right(xTDgt, 1) <> "0" Then
xStr = xStr & GetDigits(Right(xTDgt, 1))
End If
End If
GetTenDigits = xStr
End Function
Function GetDigits(xDgt)
Dim xStr As String
Dim xArr_1() As Variant
xArr_1 = Array("Zero ", "One ", "Two ", "Three ", "Four ", "Five ", "Six ", "Seven ", "Eight ", "Nine ")
xStr = ""
On Error Resume Next
xStr = xArr_1(Val(xDgt))
GetDigits = xStr
End Function

3. Щракнете върху Save икона в горния ляв ъгъл на лентата или щракнете Ctrl + S за да отворите Save As прозорец.

4. В Save As прозорец, въведете името на работната книга в Име на файл кутия. И изберете Добавка на Excel (*.xlam) опция в Запиши като тип падащ списък.

5. След това кликнете върху Save бутон за запазване на работната книга с VBA код като Добавка за Excel.

6. Обратно към Excel, затворете празната работна книга, която е била запазена като добавка на Excel.

7. Отворете нова работна книга с данни, необходими за конвертиране. Въведете формулата =БройдоДуми(A2) в клетка B2. The #NAME? ще бъде върната стойност за грешка, тъй като VBA кодът все още не е приложен във всички работни книги.

8. Отиди в Софтуерен Инженер кликнете върху Добавки за Excel в Добавките група.

9. В Добави изскача диалогов прозорец. Щракнете върху паса бутон.

10. Изберете добавката, която току-що сте запазили, след което щракнете върху OK бутон.

11. След това Добавка за преобразуване на числа в думи се вмъква и включва. Щракнете върху OK бутон, за да завършите настройката.

12. Сега, когато въвеждате формулата =БройдоДуми(A2) в клетка B2 и натиснете Въведете ключ, ще бъдат върнати съответните английски думи. Плъзнете манипулатора за автоматично попълване надолу, за да получите всички резултати.

бележки:

Ако трябва да стартирате кода ръчно, няма начин да го намерите от горните стъпки. моля те не се тревожи Има два начина за да стартирате кода.

1. Можете да добавите код към Бърза лента с инструменти и стартирайте кода всеки път, когато се щракне върху бутона за код в лентата с инструменти.
   
2. Можете също директно да натиснете Alt + F11 за да отворите полето за операция с код, намерете кода и натиснете F5 да бягам.

---

Най-добрите инструменти за производителност в офиса

Kutools за Excel решава повечето от вашите проблеми и увеличава вашата производителност с 80%

• Супер Формула Бар (лесно редактиране на няколко реда текст и формула); Оформление за четене (лесно четене и редактиране на голям брой клетки); Поставяне във филтриран диапазон...
• Обединяване на клетки/редове/колони и съхраняване на данни; Съдържание на разделени клетки; Комбинирайте дублиращи се редове и сума/средно... Предотвратяване на дублиращи се клетки; Сравнете диапазони...
• Изберете Дублиран или Уникален редове; Изберете Празни редове (всички клетки са празни); Super Find и Fuzzy Find в много работни тетрадки; Произволен избор...
• Точно копие Множество клетки без промяна на референтната формула; Автоматично създаване на препратки към множество листа; Вмъкване на куршуми, квадратчета за отметка и други...
• Любими и бързо вмъкнати формули, диапазони, диаграми и снимки; Шифроване на клетки с парола; Създаване на пощенски списък и изпращайте имейли...
• Извличане на текст, Добавяне на текст, Премахване по позиция, Премахване на пространството; Създаване и отпечатване на междинни суми за пейджинг; Конвертиране на съдържание и коментари между клетки...
• Супер филтър (запазване и прилагане на филтърни схеми към други листове); Разширено сортиране по месец/седмица/ден, честота и други; Специален филтър с удебелен шрифт, курсив...
• Комбинирайте работни тетрадки и работни листове; Обединяване на таблици въз основа на ключови колони; Разделете данните на няколко листа; Пакетно конвертиране на xls, xlsx и PDF...
• Групиране на обобщена таблица по номер на седмицата, ден от седмицата и други... Показване на отключени, заключени клетки с различни цветове; Маркирайте клетки, които имат формула/име...

Прочети повече ... Пълни функции 30-дневен безплатен пробен период... Покупка... 

---

Раздел Office - предоставя интерфейс с раздели в Office и прави работата ви много по-лесна

• Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
• Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
• Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!

Прочети повече ... Пълни функции 30-дневен безплатен пробен период... Покупка...