VBA-Handling in der Entwicklungsumgebung

VBA-Handling in der Entwicklungsumgebung. 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
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt