| Sammlung diverser Makros | |
| | |
| | |
| Blattschutz durch Makro | Sub SchutzAusEin() | |
| aus- und einschalten | ActiveSheet.Unprotect "Test" | |
| MsgBox "Blattschutz ist aufgehoben!" | |
| ActiveSheet.Protect "Test" | |
| MsgBox "Blattschutz ist gesetzt!" | |
| | End Sub | |
| Tastatureingaben | Sub Auto_Open() | |
| abfangen | Application.OnKey "%{F8}", "TueDiesUndDas" | |
| End Sub | |
| Sub TueDiesUndDas() | |
| MsgBox ActiveCell.Address | |
| | End Sub | |
| Excel-Version auslesen | Function fGetExcelVer() As Integer | |
| If Application.Version Like "*5*" Then | |
| fGetExcelVer = 5 | |
| ElseIf Application.Version Like "*7*" Then | |
| fGetExcelVer = 7 | |
| Else | |
| fGetExcelVer = 8 | |
| End If | |
| End Function | |
| Sub PerVersion() | |
| MsgBox Application.Version | |
| Select Case Left(Application.Version, 1) | |
| Case "5" | |
| MsgBox "Sie verwenden Excel 5" | |
| Case "7" | |
| MsgBox "Sie verwenden Excel 7/95" | |
| Case "8" | |
| MsgBox "Sie verwenden Excel 8/97" | |
| Case Else | |
| MsgBox "Sie verwenden eine unbekannte Excel-Version" |
| End Select | |
| ThisWorkbook.Activate | |
| | End Sub | |
| Kalenderwoche berechnen | Function DKW(dat As Date) As Integer | |
| Dim a As Integer | |
| a = Int((dat - DateSerial(Year(dat), 1, 1) + ((WeekDay(DateSerial(Year(dat), 1, 1)) + 1) Mod 7) - 3) / 7) + 1 |
| If a = 0 Then | |
| a = DKW(DateSerial(Year(dat) - 1, 12, 31)) | |
| ElseIf a = 53 And (WeekDay(DateSerial(Year(dat), 12, 31)) - 1) Mod 7 <= 3 Then |
| a = 1 | |
| End If | |
| DKW = a | |
| End Function | |
| Function KWoche(d As Date) As Integer | |
| Dim t& | |
| t = DateSerial(Year(d + (8 - WeekDay(d)) Mod 7 - 3), 1, 1) |
| KWoche = (d - t - 3 + (WeekDay(t) + 1) Mod 7) \ 7 + 1 | |
| | End Function | |
| Stellenzahl auslesen | Function CountDigits(s As String) As Integer | |
| Dim i | |
| For i = 1 To Len(s) | |
| If Mid(s, i, 1) Like "#" Then | |
| CountDigits = CountDigits + 1 | |
| End If | |
| Next i | |
| | End Function | |
| Benutzernamen anzeigen | Sub FensterName() | |
| ActiveWindow.Caption = ActiveWindow.Caption & " " _ | Username aus Excel |
| & Application.UserName | |
| MsgBox Environ("USERNAME") | Username des Betriebssystems |
| | End Sub | |
| Excel-Titelzeile ändern | Sub TitelWechseln() | |
| Application.Caption = "Veränderte Titelleiste" | |
| | End Sub | |
| CSV-Datei schreiben | Sub Write_Csv() | |
| F = FreeFile(0) | |
| fname = InputBox("Enter the filename with Path:", "Please Enter Output File Name:") |
| MsgBox "File Selected is: " & fname | |
| If fname <> False Then | |
| Open fname For Output As #F | |
| Set Rng = ActiveCell.CurrentRegion | |
| Debug.Print Rng.Address | |
| FCol = Rng.Columns(1).Column | |
| LCol = Rng.Columns(Rng.Columns.Count).Column | |
| Frow = Rng.Rows(1).Row | |
| Lrow = Rng.Rows(Rng.Rows.Count).Row | |
| For i = Frow To Lrow | |
| outputLine = "" | |
| For j = FCol To LCol | |
| If j <> LCol Then | |
| outputLine = outputLine & Cells(i, j) & ";" | Semikolon als Texttrennzeichen, kann |
| Else | geändert werden |
| outputLine = outputLine & Cells(i, j) | |
| End If | |
| Next j | |
| Print #F, outputLine | |
| Next i | |
| Close #F | |
| End If | |
| End Sub | |
| Sub schreibeCSV() | |
| F = FreeFile(0) | |
| fname = InputBox("Bitte Pfad und Dateinamen der Zieldatei eingeben (z.B. c:\tmp\text.csv):", _ |
| "Eingabe Pfad und Dateiname") |
| MsgBox "Der Name der Ausgabedatei lautet: " & fname |
| fseparator = InputBox("Bitte das Trennzeichen eingeben:", "Eingabe Trennzeichen") |
| MsgBox "Das gewählte Trennzeichen ist: " & fseparator | |
| If fname <> False Then | |
| Open fname For Output As #F | |
| Set Rng = ActiveCell.CurrentRegion | |
| Debug.Print Rng.Address | |
| FCol = Rng.Columns(1).Column | |
| LCol = Rng.Columns(Rng.Columns.Count).Column | |
| Frow = Rng.Rows(1).Row | |
| Lrow = Rng.Rows(Rng.Rows.Count).Row | |
| For i = Frow To Lrow | |
| outputLine = "" | |
| For j = FCol To LCol | |
| If j <> LCol Then | |
| outputLine = outputLine & Cells(i, j) & fseparator | |
| Else | |
| outputLine = outputLine & Cells(i, j) | |
| End If | |
| Next j | |
| Print #F, outputLine | |
| Next i | |
| Close #F | |
| End If | |
| MsgBox "Vorgang abgeschlossen!" | |
| | End Sub | |
| Zellen nach Datenimport | Dim Cell As Range | |
| aufbereiten | Sub DatenUmwandeln() | |
| Dim MyRange As Range | |
| Application.ScreenUpdating = False | |
| Set MyRange = ActiveCell.CurrentRegion.Columns(7) | |
| For Each Cell In MyRange | |
| Cell.Select | |
| Application.SendKeys "{F2}+{ENTER}", True | |
| Next Cell | |
| End Sub | |
| Sub ZellenAufbereiten() | |
| For Each Cell In Selection | |
| Cell.Select | |
| Application.SendKeys "{F2}+{ENTER}", True | |
| Next | |
| | End Sub | |
| Existenz einer Datei prüfen | Function FileExist(Filename As String) As Boolean | |
| On Error GoTo HandleError | |
| FileExist = False | |
| If Len(Filename) > 0 Then FileExist = (Dir(Filename) <> "") | |
| Exit Function | |
| HandleError: | |
| FileExist = False | |
| If (Err = 1005) Then | |
| MsgBox "Error - printer missing" | |
| Resume Next | |
| Else | |
| If (Err = 68) Or (Err = 76) Then | |
| MsgBox "Unit or Path do not exist: " & Filename, vbExclamation |
| Resume Next | |
| Else | |
| MsgBox "Unexpected error " & Str(Err) & " : " & | |
| Error(Err), vbCritical | |
| End | |
| End If | |
| End If | |
| | End Function | |
| Datei löschen | Sub DelFile() | |
| If Len(Dir("c:\windows\test.txt")) > 0 Then | |
| Kill "c:\windows\test.txt" | |
| MsgBox "Test.txt has been killed" | |
| Else | |
| MsgBox "Test.Txt never existed" | |
| End If | |
| | End Sub | |
| Daten nach Access | Sub TestAdd() | |
| senden | Dim db As Database, rs As Recordset | |
| Set db = OpenDatabase("C:\Test.mdb") | |
| Set rs = db.OpenRecordset(Name:="Test", Type:=dbOpenDynaset) |
| With rs | |
| .AddNew | |
| .Fields("Name").Value = Range("A1") | |
| .Fields("Alter").Value = Range("A2") | |
| .Update | |
| End With | |
| rs.Close | |
| db.Close | |
| Set rs = Nothing | |
| | End Sub | |
| Mappe mit Dateinamen | Sub Auto_Close() 'unter Namen speichern, welcher in Zelle A1 steht |
| aus Zelle speichern | Dim f As String; r As Integer | |
| f = ThisWorkbook.Sheets(1).Cells(1; 1).Value | |
| If f = "" Then | |
| f = Application.GetSaveAsFilename(fileFilter:="Excel Workbook(*.xls), *.xls") |
| If f = False Then | |
| Exit Sub | |
| End If | |
| End If | |
| r = ThisWorkbook.Sheets(1).Cells(1; 1).Characters.Count |
| If ThisWorkbook.Sheets(1).Cells(1; 1).Characters(r - 3).Text <> ".xls" Then |
| f = f & ".xls" | |
| End If | |
| ThisWorkbook.SaveAs Filename:=f | |
| | End Sub | |
| Datei öffnen - Menü mit | Sub DateiAuswahl() | |
| definiertem Pfad starten | Dim WB As Workbook, TB As Worksheet | |
| Dim i%, dName, dFilter$ | |
| dFilter = "Excel-Dateien(*.xls), *.xls" | |
| ChDrive "d" | |
| ChDir "d:\MeineDatenl" | |
| dName = Application.GetOpenFilename(dFilter) | |
| If dName = False Then Exit Sub | |
| Set WB = Workbooks.Open(dName) | |
| Set TB = WB.Worksheets(1) | |
| For i = 1 To 20 | |
| TB.Cells(i, 5) = "Spalte E - Zeile " & i | |
| Next i | |
| | End Sub | |
| Datum als Dateiname | Sub DateAsFilename() | |
| Dim sFileName As String | |
| sFileName = Format(Now, "mmddyy") + ".xls" | |
| ActiveWorkbook.SaveAs sFileName | |
| | End Sub | |
| Schließen eines Dialog- | Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) |
| fensters verhindern | If CloseMode <> 1 Then Cancel = 1 | Prevent user from closing with the Close |
| | End Sub | Box in the title bar. |
| Kommentare per | Sub KommentarSchrift() | |
| Makro formatieren | Dim Cmt As Comment | |
| Set Cmt = ActiveCell.AddComment | |
| Cmt.Text "Mein Kommentar" | |
| With Cmt.Shape.TextFrame.Characters.Font | |
| .Name = "Arial" | |
| .Size = 14 | |
| End With | |
| | End Sub | |
| Zellbereich mit | Sub KommentarFestlegen() | |
| Kommentar versehen | Dim C As Range | |
| For Each C In Selection | |
| If Not C.Comment Is Nothing Then | |
| C.NoteText "Kommentar!" | |
| End If | |
| Next C | |
| | End Sub | |
| Größe des | Sub Kommentargrösse() | |
| Kommentarfensters | Dim Kommentarzelle As Range | |
| automatisch | Application.DisplayCommentIndicator = xlCommentAndIndicator |
| festlegen | For Each Kommentarzelle In ActiveSheet.Cells.SpecialCells(1) |
| Kommentarzelle.Comment.Shape.Select True | |
| Selection.AutoSize = True | |
| 'Selection.ShapeRange.Width = 150 | |
| 'Selection.ShapeRange.Height = 100 | |
| Next Application.DisplayCommentIndicator = xlCommentIndicatorOnly |
| | End Sub | |
| Makroausführung | Sub Pause() | |
| pausieren | Application.OnTime Now+TimeValue("00:00:01"), "Warten" |
| End Sub | |
| Sub Warten() | |
| MsgBox "Die Warterei beginnt beim OK !" | |
| NeueStunde = Hour(Now()) | |
| NeueMinute = Minute(Now()) | |
| NeueSekunde = Second(Now()) + 10 | |
| WarteZeit = TimeSerial(NeueStunde, NeueMinute, NeueSekunde) |
| Application.Wait WarteZeit | |
| MsgBox "Geschafft! 10 Sekunden sind um." | |
| | End Sub | |
| Makro durch | Private Sub Worksheet_Change(ByVal Target As Excel.Range) |
| Veränderung einer | If Target.Address = "$A$1" Or Target.Address = "$A$3" |
| Zelle starten | Then | |
| If Range("A1").Value < Range("A3").Value Then | |
| Macro1 | |
| End If | |
| End If | |
| End Sub | |
| Private Worksheet_Calculate() | |
| If Range("A1").Value < Range("A3").Value Then | |
| Macro1 | |
| End If | |
| End Sub | |
| Private Sub Worksheet_Change(ByVal Target As Excel.Range) |
| Dim Schnittpunkt As Range | |
| Set Schnittpunkt = Application.Intersect(Target, Me.Range("A1:A20")) |
| If Schnittpunkt Is Nothing Then | |
| Exit Sub | |
| Else | |
| MsgBox "Jetzt sollte das Makro ausgeführt werden" | |
| End If | |
| | End Sub | |
| Makroausführung | Sub Screen() | |
| verbergen | Application.ScreenUpdating=False | |
| ’Dazwischen läuft das Programm ab... | |
| Application.ScreenUpdating=True | |
| | End Sub | |
| Makroausführung: | Sub Abbruch() | |
| Unterbrechen | Application.EnableCancelKey = xlDisabled | |
| verhindern | End Sub | |
| Sub Abbruch() | |
| Application.EnableCancelKey = xlErrorHandler | |
| | End Sub | |
| Makroausführung | Application.OnEntry = "MeinMakro" | Dieser Code arbeitet global in allen geöffneten |
| nach jeder Eingabe | Application.OnEntry = "" | Mappen und Tabellen. |
| Makro nicht durch | Application.DisplayAlerts = False | Diese Zeile in der ersten Zeile des Makros |
| Sicherheitsabfragen | | |
| unterbrechen | | eintragen. |
| Makrounterbrechung | On Error GoTo EH | |
| abfangen | Application.EnableCancelKey = xlErrorHandler | |
| While 1 = 1 'Schleife | |
| X = X 'Schleife | |
| Wend 'Schleife | |
| Exit Sub | |
| EH: | |
| MsgBox "Break Key Hit" | |
| | Application.EnableCancelKey = xlInterrupt | |
| Makros und Code | Sub OpenProzedurAnlegen() | |
| dynamisch erstellen | Dim nWB As Workbook | |
| Dim mdlWB As Object | |
| Set nWB = Workbooks.Add | |
| Set mdlWB = nWB.VBProject.VBComponents("DieseArbeitsmappe") |
| With mdlWB.CodeModule | |
| .InsertLines 3, "Private Sub Workbook_Open()" | |
| .InsertLines 4, " Msgbox ""Bin jetzt da!""" | |
| .InsertLines 5, "End Sub" | |
| End With | |
| End Sub | |
| Sub Loeschen() | |
| With Workbooks("test.xls").VBProject | |
| .VBComponents.Remove .VBComponents("Modul1") |
| End With | |
| | End Sub | |
| Untermenüs (in | Sub MenuErstellen() | |
| Symbolleiste) durch | Dim MB As CommandBar | |
| Makro erstellen | Dim Ctrl1 As CommandBarControl | |
| Dim Ctrl2 As CommandBarControl | |
| Dim Ctrl1a As CommandBarControl | |
| Dim Ctrl1b As CommandBarControl | |
| Set MB = CommandBars.Add(Name:="Neues Menü", MenuBar:=True) |
| Set Ctrl1 = MB.Controls.Add(Type:=msoControlPopup) |
| Ctrl1.Caption = "Untermenü1" |
| Set Ctrl2 = MB.Controls.Add(Type:=msoControlPopup) |
| Ctrl2.Caption = "Untermenü2" |
| Set Ctrl1a = Ctrl1.Controls.Add(Type:=msoControlPopup) |
| Ctrl1a.Caption = "Daten" |
| Set Ctrl1b = Ctrl1.Controls.Add(Type:=msoControlPopup) |
| Ctrl1b.Caption = "Übertragen" | |
| CommandBars("Neues Menü").Visible = True | |
| | End Sub | |
| Menü "Symbolleisten" | Sub DisableToolbarMenu() | |
| de/aktivieren | CommandBars("Toolbar List").Enabled = False | |
| End Sub | |
| Sub DisableToolbarMenu() | |
| CommandBars("Toolbar List").Enabled = True | |
| | End Sub | |
| Menüs dynamisch | Private Sub Workbook_Activate() | |
| ein- und ausblenden | MenuBars(xlWorksheet).Menus.Add "&Test Menü" | |
| Set ml = MenuBars(xlWorksheet).Menus("Test Menü") |
| With ml | |
| .MenuItems.Add Caption:="&Daten erfassen", OnAction:="DatenSpeichern" |
| .MenuItems.AddMenu Caption:="&Auswertungen" | |
| With .MenuItems("Auswertungen") | |
| .MenuItems.Add Caption:="&Auswertung1", OnAction:="" |
| .MenuItems.Add Caption:="A&uswertung2", OnAction:="" |
| End With | |
| End With | |
| End Sub | |
| Private Sub Workbook_Deactivate() | |
| MenuBars(xlWorksheet).Reset | |
| End Sub | |
| Private Sub Workbook_Open() | |
| MenuBars(xlWorksheet).Menus.Add "&Test Menü" |
| Set ml = MenuBars(xlWorksheet).Menus("Test Menü") |
| With ml |
| .MenuItems.Add Caption:="&Daten erfassen", OnAction:="DatenSpeichern" |
| .MenuItems.AddMenu Caption:="&Auswertungen" |
| With .MenuItems("Auswertungen") |
| .MenuItems.Add Caption:="&Auswertung1", OnAction:="" |
| .MenuItems.Add Caption:="A&uswertung2", OnAction:="" |
| End With | |
| End With | |
| | End Sub | |
| Symbolleisten | Sub Verstecken() | |
| ausblenden | For Each tb in Toolbars | |
| tb.Visible = False | |
| Next tb | |
| | End Sub | |
| Shortcut-Menü ein- | Sub ShortCutOnOff() | |
| und ausschalten | Application.ShortcutMenus(xlWorksheetCell).Enabled = False |
| | End Sub | |
| Symbolleiste: | Sub SymbolGrauen() | |
| Icons deaktivieren | CommandBars("Standard").Controls(1).Enabled = False |
| | End Sub | |
| Symbolleiste | Sub NeueSymbolleiste() | |
| positionieren | Dim cmdB As CommandBar | |
| et cmdB = CommandBars.Add("MyToolbar", temporary:=True) |
| With cmdB | |
| .Left = 50 | |
| .Top = 100 | |
| .Visible = True | |
| End With | |
| | End Sub | |
| ID von Symbolleisten | ’Drei verschiedene Makros können verwendet werden: | |
| und Symbolen | ’CommandBarControlID_List liefert die IDs der Symbolleisten mit Menüpunkt, ID-Nr und Beschreibung |
| auslesen | ’CommandBarFaceID_List liefert alle FaceIDs mit Bild und ID |
| ’CommandBar_List liest die Excel-internen Bezeichnungen der Menüs, Menüpunkte, deren Typ und ID aus |
| Dim cbb As CommandBarButton, ComBar As CommandBar, cbc As CommandBarControl |
| Sub CommandBarControlID_List() | |
| Dim a, b, c | |
| Application.ScreenUpdating = False | |
| For Each ComBar In Application.CommandBars | |
| If ComBar.Name = "test" Then ComBar.Delete | |
| Next | |
| Set ComBar = Application.CommandBars.Add(Name:="test", |
| Position:=msoBarTop) | |
| b = 0 | |
| c = 1 | |
| For a = 1 To 50000 | |
| On Error Resume Next | |
| Set cbb = ComBar.Controls.Add(Id:=a) | |
| If Err.Number <> 0 Then GoTo weiter | |
| cbb.CopyFace | |
| With Workbooks("FaceIDs").Sheets(1) | |
| .Cells((c Mod 100) + 1, (c \ 100) + b + 1).Formula = a | |
| .Cells((c Mod 100) + 1, (c \ 100) + b + 2).Activate | |
| ActiveSheet.Paste | |
| .Cells((c Mod 100) + 1, (c \ 100) + b + 3).Formula = cbb.Caption |
| End With | |
| If (c + 1) Mod 100 = 0 Then b = b + 3 | |
| c = c + 1 | |
| weiter: | |
| Application.CommandBars("test").FindControl(Id:=a).Delete |
| Err.Clear | |
| Next | |
| End Sub | |
| Sub CommandBarFaceID_List() | |
| Dim a, b | |
| Application.ScreenUpdating = False | |
| For Each ComBar In Application.CommandBars | |
| If ComBar.Name = "test" Then ComBar.Delete | |
| Next | |
| On Error Resume Next | |
| Set ComBar = Application.CommandBars.Add(Name:="test", |
| Position:=msoBarTop) | |
| Set cbb = ComBar.Controls.Add(Id:=1) | |
| b = 0 | |
| For a = 1 To 3518 | |
| With cbb | |
| .FaceId = a | |
| .CopyFace | |
| End With | |
| With ThisWorkbook.Sheets(1) | |
| .Cells((a Mod 100) + 1, (a \ 100) + b + 1).Formula = a | |
| .Cells((a Mod 100) + 1, (a \ 100) + b + 2).Activate | |
| ActiveSheet.Paste | |
| End With | |
| If (a + 1) Mod 100 = 0 Then b = b + 2 | |
| Next | |
| End Sub | |
| Sub CommandBar_List() | |
| Application.ScreenUpdating = False | |
| Dim a, b, c, cbc, d | |
| b = 1 | |
| d = 0 | |
| For Each a In Application.CommandBars | |
| Cells(b + d, 1) = a.Name | |
| Cells(b + d, 2) = "Item-no: " & b | |
| For Each cbc In a.Controls | |
| d = d + 1 | |
| Cells(b + d, 3) = cbc.Caption | |
| Cells(b + d, 4) = Cells(cbc.Type, 10) | |
| Cells(b + d, 5) = "Type: " & cbc.Type | |
| Cells(b + d, 6) = "ID: " & cbc.Id | |
| Next | |
| b = b + 1 | |
| Next | |
| | End Sub | |
| Menüeintrag | Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, _ |
| neuen Befehl | ByVal Target As Excel.Range, Cancel As Boolean) |
| zuordnen | Set chgEinfügen = Application.ShortcutMenus(xlWorksheetCell).MenuItems("Einfügen") |
| With chgEinfügen | |
| .OnAction = "mkrEinfügen" | |
| End With | |
| End Sub | |
| Sub mkrEinfügen() | |
| Selection.PasteSpecial Paste:=xlValues | |
| | End Sub | |
| Quickinfo zuordnen | Sub QuickInfo() | |
| Application.Toolbars("SybolleistenName").ToolbarButtons(Indexzahl).Name = "Infotext" |
| | End Sub | |
| Zahl in Text ändern | Function DollarText(vNumber) As Variant | |
| Dim sDollars As String, sCents As String, iLen As Integer, sTemp As String |
| Dim iPos As Integer, iHundreds As Integer, iTens As Integer, iOnes As Integer |
| Dim bHit As Boolean, vOnes As Variant, vTeens As Variant, vTens As Variant |
| Dim sUnits(2 To 5) As String | |
| If Not IsNumeric(vNumber) Then | |
| Exit Function | |
| End If | |
| sDollars = Format(vNumber, "###0.00") | |
| iLen = Len(sDollars) - 3 | |
| If iLen > 15 Then | |
| DollarText = CVErr(xlErrNum) | |
| Exit Function | |
| End If | |
| sCents = Right$(sDollars, 2) & "/100 Dollars" | |
| If vNumber < 1 Then | |
| DollarText = sCents | |
| Exit Function | |
| End If | |
| sDollars = Left$(sDollars, iLen) | |
| vOnes = Array("", "One", "Two", "Three", | |
| "Four", "Five", "Six", "Seven", "Eight", "Nine") | |
| vTeens = Array("Ten", "Eleven", "Twelve", | |
| "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", |
| "Eighteen", "Nineteen") | |
| vTens = Array("", "", "Twenty", "Thirty", | |
| "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety") | |
| sUnits(2) = "Thousand" | |
| sUnits(3) = "Million" | |
| sUnits(4) = "Billion" | |
| sUnits(5) = "Trillion" | |
| sTemp = "" | |
| For iPos = 15 To 3 Step -3 | |
| If iLen >= iPos - 2 Then | |
| bHit = False | |
| If iLen >= iPos Then | |
| iHundreds = Asc(Mid$(sDollars, iLen - iPos + 1, 1)) - 48 |
| If iHundreds > 0 Then | |
| sTemp = sTemp & " " & vOnes(iHundreds) & "Hundred" |
| bHit = True | |
| End If | |
| End If | |
| iTens = 0 | |
| iOnes = 0 | |
| If iLen >= iPos - 1 Then | |
| iTens = Asc(Mid$(sDollars, iLen - iPos + 2, 1)) - 48 |
| End If | |
| If iLen >= iPos - 2 Then | |
| iOnes = Asc(Mid$(sDollars, iLen - iPos + 3, 1)) - 48 |
| End If | |
| If iTens = 1 Then | |
| sTemp = sTemp & " " & vTeens(iOnes) | |
| bHit = True | |
| Else | |
| If iTens >= 2 Then | |
| sTemp = sTemp & " " & vTens(iTens) | |
| bHit = True | |
| End If | |
| If iOnes > 0 Then | |
| If iTens >= 2 Then | |
| sTemp = sTemp & "-" | |
| Else | |
| sTemp = sTemp & " " | |
| End If | |