Jak uložit a používat makra VBA ve všech sešitech v aplikaci Excel?

V některých případech možná budete muset v budoucnu použít jedno makro VBA vícekrát. Je možné uložte nějakým způsobem modul VBA do jakéhokoli nového dokumentu takže bude k dispozici ve všech sešitech? Odpověď je ano. V tomto tutoriálu vám představíme snadný způsob, jak dosáhnout vašeho cíle.

Uložte a použijte kód VBA ve všech sešitech

Chcete například použít kód VBA převádět čísla na anglická slova a uložte modul VBA do všech sešitů pro případ, že byste v budoucnu chtěli použít kód VBA. Postupujte prosím následovně.

1. zmáčkni Alt + F11 klíče v aplikaci Excel a otevře Microsoft Visual Basic pro aplikace okno.

2. cvaknutí Vložit > Modul a vložte následující makro do okna modulu.

Kód VBA: Převod čísel na slova

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. Klepněte na tlačítko Uložit ikonu v levém horním rohu pásu karet nebo klikněte Ctrl + S k otevření Uložit jako okno.

4. V Uložit jako v okně zadejte název sešitu do Název souboru box. A vyberte Doplněk aplikace Excel (*.xlam) možnost v Uložit jako typ rozbalovací seznam.

5. Poté klikněte na tlačítko Uložit tlačítko pro uložení sešitu s kódem VBA jako soubor Doplněk aplikace Excel.

6. Zpět na vynikat, zavřete prázdný sešit, který byl uložen jako doplněk aplikace Excel.

7. Otevřete nový sešit s daty, která je třeba převést. Zadejte vzorec = NumberstoWords (A2) v buňce B2. The # Název? bude vrácena chybová hodnota, protože kód VBA ještě nebyl použit ve všech sešitech.

8. Přejít na Vývojka klepněte na kartu Doplňky aplikace Excel v Doplňky skupina.

9. Přidat objeví se dialogové okno. Klikněte na ikonu Procházet .

10. Vyberte doplněk, který jste právě uložili, a klepněte na OK .

11. Potom Doplněk Převést číslo na slova se vloží a zapne se. Klikněte na OK dokončete nastavení.

12. Nyní, když zadáte vzorec = NumberstoWords (A2) v buňce B2 a stiskněte vstoupit klíč, budou vrácena odpovídající anglická slova. Chcete-li získat všechny výsledky, přetáhněte úchyt automatického vyplňování dolů.

Poznámky:

Pokud potřebujete spustit kód ruční, neexistuje způsob, jak jej najít z výše uvedených kroků. Prosím, nedělejte si starosti. Existují dvě cesty spustit kód.

1. Můžete přidat kód do Rychlý panel nástrojů a spusťte kód pokaždé, když klepnete na tlačítko kódu na panelu nástrojů.
   
2. Můžete také přímo stisknout Alt + F11 otevřete okno pro ovládání kódu, vyhledejte kód a stiskněte F5 běžet.

---

Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

• Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
• Sloučit buňky / řádky / sloupce a uchovávání údajů; Rozdělit obsah buněk; Zkombinujte duplicitní řádky a součet / průměr... Zabraňte duplicitním buňkám; Porovnat rozsahy...
• Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
• Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
• Oblíbené a rychlé vkládání vzorců„Rozsahy, grafy a obrázky; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
• Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
• Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
• Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
• Seskupování kontingenčních tabulek podle číslo týdne, den v týdnu a další ... Zobrazit odemčené, zamčené buňky různými barvami; Zvýrazněte buňky, které mají vzorec / název...

Čtěte více... Plné funkce 30denní bezplatná zkušební verze ... Nákup... 

---

Karta Office - přináší do Office rozhraní s kartami a usnadňuje vám práci

• Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
• Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
• Zvyšuje vaši produktivitu o 50%a snižuje stovky kliknutí myší každý den!

Čtěte více... Plné funkce 30denní bezplatná zkušební verze ... Nákup...