Як зберегти та використовувати свої макроси VBA в усіх книгах Excel?

У деяких випадках вам може знадобитися використовувати один макрос VBA кілька разів у майбутньому. Чи можна якось збережіть модуль VBA в будь-якому новому документі тож він буде доступний у всіх книгах? Відповідь - так. У цьому підручнику ми представимо простий спосіб досягнення вашої мети.

Збережіть і використовуйте код VBA в усіх книгах

Наприклад, ви хочете використовувати код VBA для перетворення чисел в англійські слова та зберегти модуль VBA у всіх робочих книгах якщо ви захочете використовувати код VBA в майбутньому. Будь ласка, зробіть наступне.

1 Натисніть кнопку Alt + F11 клавіші в Excel, і він відкриває Microsoft Visual Basic для додатків вікна.

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

Код 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. Натисніть зберегти у верхньому лівому куті стрічки або клацніть Ctrl + S відкрити Зберегти як вікна.

4 В Зберегти як вікно, введіть назву робочої книги в Файл коробка. І виберіть Надбудова Excel (*.xlam) опція в Зберегти як випадаючий список.

5 Потім натисніть на зберегти кнопку, щоб зберегти книгу з кодом VBA як Додаток Excel.

6. Повернутися до перевершувати, закрийте порожню робочу книгу, яку було збережено як надбудову Excel.

7. Відкрийте нову книгу з даними, які потрібно перетворити. Введіть формулу = NumberstoWords (A2) у комірці B2. The # ІМ'Я? буде повернено значення помилки, оскільки код VBA ще не застосовано в усіх книгах.

8. До Розробник вкладка, клацніть Надбудови Excel в Add-ins група.

9. Додати до спливає діалогове вікно. Клацніть на перегорнути кнопки.

10. Виберіть надбудову, яку ви щойно зберегли, а потім натисніть OK кнопки.

11. Тоді Надбудова «Перетворення чисел на слова». вставлено та ввімкнено. Натисніть на OK , щоб завершити налаштування.

12. Тепер, коли ви вводите формулу = NumberstoWords (A2) у клітинку B2 і натисніть Що натомість? Створіть віртуальну версію себе у ключ, буде повернено відповідні англійські слова. Перетягніть маркер автозаповнення вниз, щоб отримати всі результати.

примітки:

Якщо потрібно запустити код вручну, неможливо знайти його за допомогою наведених вище кроків. Будь ласка, не хвилюйтеся. Існує два способи для запуску коду.

1. Ви можете додати код до Швидка панель інструментів і запускати код щоразу, коли на панелі інструментів натискають кнопку коду.
   
2. Ви також можете безпосередньо натиснути Alt + F11 щоб відкрити вікно операції з кодом, знайдіть код і натисніть F5 бігти.

---

Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

• Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
• Об’єднати клітинки / рядки / стовпці та Ведення даних; Вміст розділених комірок; Поєднуйте повторювані рядки та суму / середнє... Запобігання дублюючим клітинам; Порівняйте діапазони...
• Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
• Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
• Улюблені та швидко вставлені формули, Діапазони, діаграми та зображення; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
• Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
• Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
• Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
• Групування зведеної таблиці за номер тижня, день тижня та багато іншого ... Показати розблоковані, заблоковані клітини за різними кольорами; Виділіть клітини, які мають формулу / назву...

Детальніше ... Повні можливості 30-денної безкоштовної пробної версії ... Придбати ... 

---

Вкладка Office - надає інтерфейс із вкладками в Office і значно полегшує вашу роботу

• Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
• Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
• Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!

Детальніше ... Повні можливості 30-денної безкоштовної пробної версії ... Придбати ...