alleMakrosExportieren, alleMakrosImportieren - LfFehler 1004
16.07.2024 14:38:09
tuska
ich bitte um Unterstützung bei diesem Thema.
(Achtung: Nur Hobbyanwender - KEINE CODE-Kenntnisse).
Erwähnen möchte ich, dass diese Makros früher ohne Probleme funktioniert haben
jedoch in dieser Konfiguration NICHT mehr funktionieren:
Microsoft® Excel® LTSC MSO (16.0.14332.20734) 64-Bit,
Bestandteil von: Microsoft Office LTSC Professional Plus 2021
Windows 11 Pro (x64) Version 23H2 (OS Build 22631.3880) - Letztes Revisionsdatum: 9.7.2024
Nach Ausführung des Makros "alleMakrosExportieren" erhalte ich folgende Hinweismeldung:
"Laufzeitfehler '1004':
Der programmatische Zugriff auf das Visual Basic-Projekt ist nicht sicher"
... und nach Klick auf den Button "Debuggen" wird mir diese Zeile gelb eingefärbt angezeigt:
For Each vbc In ThisWorkbook.VBProject.VBComponents-------------------
Nach Ausführung des Makros "alleMakrosImportieren" erhalte ich folgende Hinweismeldung:
"Laufzeitfehler '1004':
Der programmatische Zugriff auf das Visual Basic-Projekt ist nicht sicher"
... und nach Klick auf den Button "Debuggen" wird mir diese Zeile gelb eingefärbt angezeigt:
With ThisWorkbook.VBProject ' Workbooks("Testmappe.xls").VBProjectBeide Makros befinden sich in Modul 471.
Diese Makros habe ich vor sehr langer Zeit integriert, zum jetzigen Zeitpunkt bin ich mir aber nicht sicher,
ob ich in einem neuen Arbeitsblatt den Code in "DieseArbeitsmappe" einfügen muß oder ob ich
ein neues Modul einfügen muß und auf diesem den Code einfügen soll.
Bitte zu diesem Punkt um eine Auskunft.
Danke im voraus für die Bemühungen.
Gruß,
Karl
Option Explicit
Public Sub alleMakrosExportieren()
' von Nepumuk
' Export des gesamten Codes
' aus ThisWorkbook
' vor Export sollten bereits vorhandener Code im Verzeichnis gelöscht werden
' damit es mit dem Import Fehlerfrei geht
Dim vbc As Object, iCounter As Integer, sMacro As String, cType As String
For Each vbc In ThisWorkbook.VBProject.VBComponents
With vbc.CodeModule
For iCounter = 1 To .CountOfLines
If .ProcOfLine(iCounter, 0) > "" Or InStr(1, .Lines(iCounter, 1), "Dim") > 0 _
Or InStr(1, .Lines(iCounter, 1), "Public") > 0 _
Or InStr(1, .Lines(iCounter, 1), "Type") > 0 _
Or InStr(1, .Lines(iCounter, 1), "Static") > 0 _
Or InStr(1, .Lines(iCounter, 1), "Declare") > 0 Then
Select Case vbc.Type
Case 1: cType = ".bas"
Case 2, 100: cType = ".cls" 'Tabelle; DieseArbeitsmape
Case 3: cType = ".frm"
End Select
' Ablagephad
Workbooks(ThisWorkbook.Name).VBProject.VBComponents(vbc.Name).Export _
"D:\Daten\EXCEL\Vorlagen\Makros\" & vbc.Name & cType
Exit For
End If
Next iCounter
End With
Next vbc
End Sub
Public Sub alleMakrosImportieren()
' von Nepumuk
Dim vbc As Object, iCounter As Integer, StDateiname As String
With ThisWorkbook.VBProject ' Workbooks("Testmappe.xls").VBProject
For Each vbc In .VBComponents
Select Case vbc.Type
Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
Case 100
With vbc.CodeModule
.DeleteLines 1, .CountOfLines
End With
End Select
Next
StDateiname = Dir("D:\Daten\EXCEL\Vorlagen\Makros\" & "*.*")
Do While StDateiname > ""
If UCase(Right(StDateiname, 4)) = ".BAS" Or UCase(Right(StDateiname, 4)) = ".FRM" Or UCase(Right(StDateiname, 4)) = ".CLS" Then
.VBComponents.Import "D:\Daten\EXCEL\Vorlagen\Makros\" & StDateiname
End If
StDateiname = Dir
Loop
For Each vbc In .VBComponents
If vbc.Type = 2 Then
If Left(vbc.Name, 5) = "Diese" Or Left(vbc.Name, 7) = "Tabelle" Then
.VBComponents(Left(vbc.Name, Len(vbc.Name) - 1)).CodeModule.InsertLines 1, vbc.CodeModule.Lines(1, vbc.CodeModule.CountOfLines)
.VBComponents.Remove .VBComponents(vbc.Name)
End If
End If
Next vbc
End With
End SubAnzeige