| VBE.MainWindow, VBProject.VBComponents, CodeName |
| |
| |
| Entwicklungsumgebung (EU) wechselweise | Sub Ein_Ausblenden() |
| ein- und ausblenden (das Makro eventuell | If Application.VBE.MainWindow.Visible = True Then |
| einer Schaltfläche zuweisen). | Application.VBE.MainWindow.Visible = False |
| Alternativ kann die EU mit ALT & F11 | Else |
| aufgerufen werden. | Application.VBE.MainWindow.Visible = True |
| End If |
| End Sub |
| | |
| Einer Arbeitsmappe fünf Blätter hinzufügen, hinten | Sub Hinzufuegen() |
| anhängen und Blattnamen vergeben | Dim i% |
| For i = 1 To 5 |
| ActiveWorkbook.Sheets.Add.Move After:=Worksheets(Worksheets.Count) |
| ActiveSheet.Name = "Blatt" & i |
| Next i |
| Worksheets(1).Select |
| End Sub |
| | |
| VBProject-Codenamen für alle Arbeitsblätter | Sub VBProjectCodename() |
| vergeben | Dim i%, n%, nam$ |
| n = ActiveWorkbook.Worksheets.Count |
| For i = 1 To n |
| ActiveWorkbook.Worksheets(i).Select |
| nam = ActiveWorkbook.Worksheets(i).CodeName |
| 'Der VBProject-Codename darf nicht numerisch sein! |
| ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Worksheets(i). _ |
| CodeName).Name = "T" & ActiveWorkbook.Worksheets(i).Name |
| Next i |
| ActiveWorkbook.Worksheets(1).Select |
| End Sub |
| | |
| In einer neuen Arbeitsmappe werden alle | Sub ProzedurListen() |
| Prozedurennamen der aktiven Arbeitsmappe | Dim TB As Worksheet, Komponente As VBComponent |
| gelistet (nicht der VBA-Code!) | Dim c%, R%, i%, Anfang%, Ende%, Makro$ |
| Workbooks.Add |
| Set TB = ActiveSheet |
| For Each Komponente In ThisWorkbook.VBProject.VBComponents |
| If Komponente.Type = vbext_ct_ClassModule Or _ |
| vbext_ct_Document Or vbext_ct_StdModule Then |
| R = 1 |
| c = c + 1 |
| TB.Cells(R, c) = Komponente.Name |
| TB.Cells(R, c).Font.Bold = True |
| With Komponente.CodeModule |
| For i = 1 To .CountOfLines |
| If .ProcOfLine(i, vbext_pk_Proc) > "" Then |
| Makro = .ProcOfLine(i, vbext_pk_Proc) |
| If Makro <> TB.Cells(R, c) Then |
| R = R + 1 |
| TB.Cells(R, c) = Makro |
| End If |
| End If |
| Next i |
| End With |
| End If |
| Next Komponente |
| TB.Columns.AutoFit |
| End Sub |
| | |
| Der gesamte VBA-Code der aktiven Mappe | Sub ModulDrucken() |
| wird in neue Worksheets (oder Textdateien) | Dim i%, n%, sCode$ |
| exportiert | Application.ScreenUpdating = False |
| n = ActiveWorkbook.VBProject.VBComponents.Count |
| For i = 1 To n |
| ' ActiveWorkbook.VBProject.VBComponents(i).Export "E:\Test" & i & ".xls" |
| ActiveWorkbook.VBProject.VBComponents(i).Export "E:\Test" & i & ".txt" |
| Next i |
| Application.DisplayAlerts = False |
| End Sub |
| | |
| Eine Prozedur wird aufgerufen und | Sub ProzedurAufrufen() |
| nach dem Aufruf gelöscht | Dim Komponente As CodeModule |
| Dim Startzei&, Endzeile% |
| Set Komponente = ThisWorkbook.VBProject. _ |
| VBComponents("modMain").CodeModule |
| Startzei = Komponente.ProcBodyLine("Meldung", vbext_pk_Proc) |
| Endzeile = Komponente.ProcCountLines("Meldung", vbext_pk_Proc) |
| Komponente.DeleteLines Startzei, Endzeile |
| End Sub |
| | |
| Alle Allgemeinen und Klassenmodule | Sub ModuleAlleKopieren() |
| dieser Arbeitsmappe werden in eine | Dim WB As Workbook |
| neue Arbeitsmappe kopiert | Dim Vbc As VBComponent |
| Dim Comp() |
| Dim i% |
| Dim dName$ |
| Set WB = Workbooks.Add |
| For Each Vbc In ThisWorkbook.VBProject.VBComponents |
| If Vbc.Type = vbext_ct_ClassModule Then |
| i = i + 1 |
| dName = "Tmp" & i & ".cls" |
| ReDim Preserve Comp(i) |
| Comp(i) = dName |
| Vbc.Export dName |
| ElseIf Vbc.Type = vbext_ct_StdModule Then |
| i = i + 1 |
| dName = "Tmp" & i & ".bas" |
| ReDim Preserve Comp(i) |
| Comp(i) = dName |
| Vbc.Export dName |
| End If |
| Next Vbc |
| For i = 1 To UBound(Comp) |
| WB.VBProject.VBComponents.Import Comp(i) |
| Kill Comp(i) |
| Next i |
| End Sub |
| | |
| Erstellt eine neue Arbeitsmappe und | Sub MakroKopieren() |
| kopiert EIN bestimmtes Makro aus | Dim WB As Workbook |
| dieser Mappe in die neue Mappe | Dim Komponente As CodeModule |
| Dim Startzei& |
| Dim Endzeile% |
| Dim Txt$ |
| Set WB = Workbooks.Add |
| Set Komponente = WB.VBProject.VBComponents. _ |
| Add(vbext_ct_StdModule).CodeModule |
| With ThisWorkbook.VBProject.VBComponents("modMain").CodeModule |
| Startzei = .ProcBodyLine("TestMakro", vbext_pk_Proc) |
| Endzeile = .ProcCountLines("TestMakro", vbext_pk_Proc) |
| Txt = .Lines(Startzei, Endzeile) |
| End With |
| Komponente.AddFromString Txt |
| Application.Visible = True |
| End Sub |
| | |
| Module und Code aus Arbeitsmappe | Function bRemoveAllCode(ByVal szBook As String) As Boolean |
| entfernen | Dim objCode As Object, objComponents As Object |
| Dim lCount As Long, wkbBook As Workbook |
| Const lModule As Long = 1 |
| Const lOther As Long = 100 |
| On Error GoTo bRemoveAllCodeError |
| Set wkbBook = Workbooks(szBook) |
| Set objComponents = wkbBook.VBProject.VBComponents |
| lCount = wkbBook.VBProject.VBComponents.Count |
| For Each objCode In objComponents 'Entfernt Module und Code |
| If objCode.Type = lModule Then |
| objComponents.Remove objCode |
| ElseIf objCode.Type = lOther Then |
| objCode.CodeModule.DeleteLines 1, |
| objCode.CodeModule.CountOfLines |
| End If |
| Next objCode |
| bRemoveAllCode = True |
| Exit Function |
| bRemoveAllCodeError: |
| bRemoveAllCode = False |
| End Function |
| Sub PrepBook() |
| If Not bRemoveAllCode(ActiveWorkbook.Name) Then _ |
| MsgBox "Error!", vbCritical,"bRemoveAllCode" |
| | End Sub |
| |
zurück