Hoe u uw VBA-macro's in alle werkmappen in Excel kunt opslaan en gebruiken?

In sommige gevallen moet u in de toekomst mogelijk meerdere VBA-macro's gebruiken. is het mogelijk om sla de VBA-module op de een of andere manier op in een nieuw document zodat het beschikbaar is in alle werkmappen? Het antwoord is ja. In deze zelfstudie introduceren we een eenvoudige manier om uw doel te bereiken.

Bewaar en gebruik de VBA-code in alle werkmappen

U wilt bijvoorbeeld de VBA-code gebruiken om: zet getallen om in Engelse woorden en sla de VBA-module op in alle werkmappen voor het geval u de VBA-code in de toekomst wilt gebruiken. Ga als volgt te werk.

1. druk de Alt + F11 toetsen in Excel, en het opent het Microsoft Visual Basic voor toepassingen venster.

2. klikken Invoegen > Module en plak de volgende macro in het modulevenster.

VBA-code: cijfers naar woorden converteren

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. Klik op het Bespaar pictogram in de linkerbovenhoek van het lint of klik op Ctrl + S om de te openen Opslaan als venster.

4. In de Opslaan als venster, voer de naam van de werkmap in de Bestandsnaam doos. En selecteer de Excel-invoegtoepassing (*.xlam) optie in het Opslaan als type keuzelijst.

5. Klik vervolgens op het Bespaar knop om de werkmap met VBA-code op te slaan als een Excel-invoegtoepassing.

6. Terug naar het Excel, sluit u de lege werkmap die is opgeslagen als Excel-invoegtoepassing.

7. Open een nieuwe werkmap met gegevens die moeten worden geconverteerd. Voer de formule in = Cijfers naar Woorden (A2) in cel B2. De #NAME? foutwaarde wordt geretourneerd omdat VBA-code nog niet in alle werkmappen is toegepast.

8. Naar de Ontwikkelaar tab, klik Excel-invoegtoepassingen in de Add-ins groep.

9. De Toevoegen dialoogvenster verschijnt. Klik op de Blader knop.

10. Kies de invoegtoepassing die u zojuist hebt opgeslagen en klik vervolgens op de OK knop.

11. Vervolgens de Converteer nummer naar woorden-invoegtoepassing je aangepaste is ingevoegd en ingeschakeld. Klik op de OK knop om de instelling te voltooien.

12. Wanneer u nu de formule invoert = Cijfers naar Woorden (A2) in cel B2 en druk op de Enter toets, worden de bijbehorende Engelse woorden geretourneerd. Sleep de hendel voor automatisch aanvullen naar beneden om alle resultaten te krijgen.

Opmerkingen:

Als u de code moet uitvoeren: handmatig, is er geen manier om het te vinden via de bovenstaande stappen. Maak je alsjeblieft geen zorgen. Er zijn twee manieren om de code uit te voeren.

1. U kunt code toevoegen aan de Snelle werkbalk en voer de code uit telkens wanneer op de codeknop op de werkbalk wordt geklikt.
   
2. U kunt ook rechtstreeks op drukken Alt + F11 om het codebewerkingsvenster te openen, zoek de code en druk op F5 rennen.

---

De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

• Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
• Voeg cellen / rijen / kolommen samen en het bewaren van gegevens; Gespleten cellen inhoud; Combineer dubbele rijen en som / gemiddelde... Voorkom dubbele cellen; Vergelijk Ranges...
• Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
• Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
• Favoriete formules en snel invoegen, Bereiken, grafieken en afbeeldingen; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
• Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
• Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
• Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
• Draaitabel groeperen op weeknummer, dag van de week en meer ... Toon ontgrendelde, vergrendelde cellen door verschillende kleuren; Markeer cellen met formule / naam...

Lees verder... Alle functies Gratis proefversie van 30 dagen... Aankoop... 

---

Office-tabblad - brengt interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

• Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
• Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
• Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!

Lees verder... Alle functies Gratis proefversie van 30 dagen... Aankoop...