schwalbepilot
Goto Top

Excel Makro zerstört SVerweis

Hallo,

anbei ein Makro welches sich alle Excel Dateien eines Ordners vornimmt und einen Zellbereich färbt und die Formel "=Datei" in die Fußzeile schreibt. Leider funktionieren sämtliche SVerweise nach Ausführen des Makros nicht mehr. Außerdem erkennt Excel die Formal "Datei" erst, nachdem ich einmal in die Fußzeile geklickt habe.

Danke für eure Hilfe
Sub makro_filename()
Dim sFolder As String
    ' Open the select folder prompt  
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed  
            sFolder = .SelectedItems(1) & "\"  
        End If
    End With

    Dim MyPath As String, FilesInPath As String
     Dim MyFiles() As String, Fnum As Long
     Dim mybook As Workbook
     Dim CalcMode As Long
     Dim sh As Worksheet
     Dim ErrorYes As Boolean
     Dim counter As Integer
     counter = 0
  
     MyPath = sFolder
   
     'If there are no Excel files in the folder exit the sub  
     FilesInPath = Dir(MyPath & "*.xl*")  
     If FilesInPath = "" Then  
         MsgBox "Keine Dateien gefunden"  
         Exit Sub
     End If
    'Fill the array(myFiles)with the list of Excel files in the folder  
     Fnum = 0
     Do While FilesInPath <> ""  
         Fnum = Fnum + 1
         ReDim Preserve MyFiles(1 To Fnum)
         MyFiles(Fnum) = FilesInPath
         FilesInPath = Dir()
     Loop
    'Change ScreenUpdating, Calculation and EnableEvents  
     With Application
         CalcMode = .Calculation
         .Calculation = xlCalculationManual
         .ScreenUpdating = False
         .EnableEvents = False
     End With
    'Loop through all files in the array(myFiles)  
     If Fnum > 0 Then
         For Fnum = LBound(MyFiles) To UBound(MyFiles)
             Set mybook = Nothing
             On Error Resume Next
             Set mybook = Workbooks.Open((MyPath & MyFiles(Fnum)), , , , , WriteResPassword = "password")  
             'ActiveSheet.Unprotect ("password")  
            
             On Error GoTo 0
            If Not mybook Is Nothing Then

     counter = counter + 1
     On Error Resume Next
     For Each sh In mybook.Worksheets
    
    
    
        If sh.Name = "Hilfstabelle" Or sh.Name = "Erklärungen" Or sh.Name = "Erklärungsseite" Or sh.Name = "Zusammenfassung Regelkarten" Then  
     
        Else
             With sh
                 .Unprotect ("Mathys")  
                 .PageSetup.LeftFooter = "Form-Nr. " & "&[Datei]"  
                 .Range("A6:I10").Interior.Color = RGB(230, 230, 230)  
                 '.Protect ("password")  
                'MsgBox (sh.Name)  
                'Fußzeile ändern  
                
             End With
       End If
     Next sh
    
    

                 If Err.Number > 0 Then
                     ErrorYes = True
                     Err.Clear
                    
                     'Close mybook without saving  
                     mybook.Close savechanges:=False
                 Else
                     'Save and close mybook  
                     mybook.Close savechanges:=True
                 End If
                 On Error GoTo 0
             Else
                 'Not possible to open the workbook  
                 ErrorYes = True
             End If
        Next Fnum
     End If
   
    MsgBox (counter & " Dateien geändert"), , "Erfolgreich"  
   
    'If ErrorYes = True Then  
    '    MsgBox "There are problems in one or more files, possible problem:" _  
    '         & vbNewLine & "protected workbook/sheet or a sheet/range that not exist"  
    'End If  
    'Restore ScreenUpdating, Calculation and EnableEvents  
     With Application
         .ScreenUpdating = True
         .EnableEvents = True
         .Calculation = CalcMode
     End With
 End Sub
 

Content-Key: 371260

Url: https://administrator.de/contentid/371260

Ausgedruckt am: 28.03.2024 um 18:03 Uhr

Mitglied: Kraemer
Lösung Kraemer 16.04.2018 aktualisiert um 16:57:16 Uhr
Goto Top
Moin,

Leider funktionieren sämtliche SVerweise nach Ausführen des Makros nicht mehr
schmeißen die einen Fehler oder was willst du uns damit sagen?
Funktionieren andere Formeln noch?

Gruß

BTW: Dein Code ist fürchterlich formatiert. Macht die Fehlersuche nicht einfacher.
BTW: In VBA gibt es "if not" - ein if - tu nichts - else - tu was ist also nicht nötig...
Mitglied: Meierjo
Meierjo 16.04.2018 aktualisiert um 17:36:53 Uhr
Goto Top
Hallo

Was steht denn in der Formel [Datei]?? Der Dateiname??

Hiermit kannst du zB den Dateinamen inkl. Pfad vor dem Ausdrucken eintragen lassen


Gruss
Mitglied: schwalbepilot
schwalbepilot 19.04.2018 um 00:58:31 Uhr
Goto Top
Danke für die Antwort,
ja ich bin nicht gut im Formatieren, vieles mache ich auch noch mit Copy&Paste, dadurch ist auch viel Code unnötig. Bei den Feldern vom SVerweis wird jetzt auf einmal kein Fehler mehr generiert.

Vielen Dank
Mitglied: schwalbepilot
schwalbepilot 19.04.2018 um 01:00:09 Uhr
Goto Top
Genau, am Ende soll da der aktuelle Dateiname stehen, aber als Formel, denn das Feld soll immer aktuell sein, damit man das Makro nur einmal ausführen muss.