was stimmt bitte in meinem Code (s. am Ende) nicht?
Ich bekomme diese Fehlermeldung: Fehler beim Kompilieren: Methode oder Datenobjekt nicht gefunden.
Es sollen zwei Module gelöscht werden und aus einer Datei wieder importiert werden.
Ich darf nicht davor ThisWorkbook eintragen, weil der Code nicht in aktiver Datei sondern in zuvor ausgewählten Dateien durch das Makro "formatWithoutColor" ausgeführt werden soll.
Sub formatWithoutColor()
Dim varWB As Variant, intIndex As Integer
On Error GoTo ErrExit
GMS
varWB = Application.GetOpenFilename(Filefilter:="Excel (*.xls), *.xls", _
Title:="Bitte Datei(en) für Formatierung auswählen, Abbrechen beendet das Makro", _
MultiSelect:=True)
If IsArray(varWB) Then
For intIndex = 1 To UBound(varWB)
Application.StatusBar = "Datei " & Format(intIndex, "00") & " von " & Format(UBound( _
varWB), "00") & ": "
FormatSheets varWB(intIndex)
Next
Application.StatusBar = False
End If
ErrExit:
If Err.Number 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
GMS True
End Sub
Sub FormatSheets(ByVal FileName As String, Optional ByVal withColor As Boolean = False)
Dim wb As Workbook, objWB As Workbook, objWS As Worksheet
Dim rng As Range, rngDel As Range, strFirst As String, lngR As Long, blnWasOpen As Boolean
Dim objShp As Shape, lngLastRow As Long, lngLastCol As Long
Dim dblLeft As Double, aLinks As Variant, intI As Integer
For Each wb In Application.Workbooks
If wb.FullName = FileName Then
Set objWB = wb
blnWasOpen = True
Exit For
End If
Next
If objWB Is Nothing Then Set objWB = Workbooks.Open(FileName, UpdateLinks:=False)
aLinks = objWB.LinkSources(xlExcelLinks)
If Not IsEmpty(aLinks) Then
For intI = 1 To UBound(aLinks)
objWB.BreakLink aLinks(intI), xlLinkTypeExcelLinks
Next
End If
Application.StatusBar = Application.StatusBar & objWB.Name
If Not SheetExist("Massbild", objWB.Name) Then
objWB.Worksheets.Add After:=objWB.Sheets(objWB.Sheets.Count)
objWB.Sheets(objWB.Sheets.Count).Name = "Massbild"
End If
For Each objWS In objWB.Worksheets
With objWS
'Tabellenblat Einrichten
.Activate 'wegen Gitternetzlinien
'Das bestehende Modul1 zuerst umbenennen und dann mit diesem Namen löschen.
.VBProject.VBComponents("Modul1").Name = "Modul99"
.VBProject.VBComponents.Remove .VBProject.VBComponents("Modul99")
'Neues Modul importieren und umbenennen
.VBProject.VBComponents.Import ("D:\Daten\Modul1.bas")
.VBProject.VBComponents(.VBProject.VBComponents.Count).Name = "Modul1"
.VBProject.VBComponents("Modulo1").Name = "Modul88"
.VBProject.VBComponents.Remove .VBProject.VBComponents("Modul88")
'Neues Modul importieren und umbenennen
.VBProject.VBComponents.Import ("D:\Daten\Modul2.bas")
.VBProject.VBComponents(.VBProject.VBComponents.Count).Name = "Modul2"
Beste Grüße,
Sergej