Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

gelöst Excel Makro zerstört SVerweis

Mitglied: schwalbepilot

schwalbepilot (Level 1) - Jetzt verbinden

16.04.2018 um 15:38 Uhr, 475 Aufrufe, 4 Kommentare

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
01.
Sub makro_filename()
02.
Dim sFolder As String
03.
    ' Open the select folder prompt
04.
    With Application.FileDialog(msoFileDialogFolderPicker)
05.
        If .Show = -1 Then ' if OK is pressed
06.
            sFolder = .SelectedItems(1) & "\"
07.
        End If
08.
    End With
09.

10.
    Dim MyPath As String, FilesInPath As String
11.
     Dim MyFiles() As String, Fnum As Long
12.
     Dim mybook As Workbook
13.
     Dim CalcMode As Long
14.
     Dim sh As Worksheet
15.
     Dim ErrorYes As Boolean
16.
     Dim counter As Integer
17.
     counter = 0
18.
  
19.
     MyPath = sFolder
20.
   
21.
     'If there are no Excel files in the folder exit the sub
22.
     FilesInPath = Dir(MyPath & "*.xl*")
23.
     If FilesInPath = "" Then
24.
         MsgBox "Keine Dateien gefunden"
25.
         Exit Sub
26.
     End If
27.
    'Fill the array(myFiles)with the list of Excel files in the folder
28.
     Fnum = 0
29.
     Do While FilesInPath <> ""
30.
         Fnum = Fnum + 1
31.
         ReDim Preserve MyFiles(1 To Fnum)
32.
         MyFiles(Fnum) = FilesInPath
33.
         FilesInPath = Dir()
34.
     Loop
35.
    'Change ScreenUpdating, Calculation and EnableEvents
36.
     With Application
37.
         CalcMode = .Calculation
38.
         .Calculation = xlCalculationManual
39.
         .ScreenUpdating = False
40.
         .EnableEvents = False
41.
     End With
42.
    'Loop through all files in the array(myFiles)
43.
     If Fnum > 0 Then
44.
         For Fnum = LBound(MyFiles) To UBound(MyFiles)
45.
             Set mybook = Nothing
46.
             On Error Resume Next
47.
             Set mybook = Workbooks.Open((MyPath & MyFiles(Fnum)), , , , , WriteResPassword = "password")
48.
             'ActiveSheet.Unprotect ("password")
49.
            
50.
             On Error GoTo 0
51.
            If Not mybook Is Nothing Then
52.

53.
     counter = counter + 1
54.
     On Error Resume Next
55.
     For Each sh In mybook.Worksheets
56.
    
57.
    
58.
    
59.
        If sh.Name = "Hilfstabelle" Or sh.Name = "Erklärungen" Or sh.Name = "Erklärungsseite" Or sh.Name = "Zusammenfassung Regelkarten" Then
60.
     
61.
        Else
62.
             With sh
63.
                 .Unprotect ("Mathys")
64.
                 .PageSetup.LeftFooter = "Form-Nr. " & "&[Datei]"
65.
                 .Range("A6:I10").Interior.Color = RGB(230, 230, 230)
66.
                 '.Protect ("password")
67.
                'MsgBox (sh.Name)
68.
                'Fußzeile ändern
69.
                
70.
             End With
71.
       End If
72.
     Next sh
73.
    
74.
    
75.

76.
                 If Err.Number > 0 Then
77.
                     ErrorYes = True
78.
                     Err.Clear
79.
                    
80.
                     'Close mybook without saving
81.
                     mybook.Close savechanges:=False
82.
                 Else
83.
                     'Save and close mybook
84.
                     mybook.Close savechanges:=True
85.
                 End If
86.
                 On Error GoTo 0
87.
             Else
88.
                 'Not possible to open the workbook
89.
                 ErrorYes = True
90.
             End If
91.
        Next Fnum
92.
     End If
93.
   
94.
    MsgBox (counter & " Dateien geändert"), , "Erfolgreich"
95.
   
96.
    'If ErrorYes = True Then
97.
    '    MsgBox "There are problems in one or more files, possible problem:" _
98.
    '         & vbNewLine & "protected workbook/sheet or a sheet/range that not exist"
99.
    'End If
100.
    'Restore ScreenUpdating, Calculation and EnableEvents
101.
     With Application
102.
         .ScreenUpdating = True
103.
         .EnableEvents = True
104.
         .Calculation = CalcMode
105.
     End With
106.
 End Sub
107.
 
Mitglied: Kraemer
LÖSUNG 16.04.2018, aktualisiert um 16:57 Uhr
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...
Bitte warten ..
Mitglied: Meierjo
16.04.2018, aktualisiert um 17:36 Uhr
Hallo

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

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


Gruss
Bitte warten ..
Mitglied: schwalbepilot
19.04.2018 um 00:58 Uhr
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
Bitte warten ..
Mitglied: schwalbepilot
19.04.2018 um 01:00 Uhr
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.
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
Excel-Makro
gelöst Frage von yuki13Microsoft Office7 Kommentare

Hallo Zusammen!! :-) Ich bin nicht so fit in Excel Makros und wollte mich hier erkundigen, ob mir jemand ...

Microsoft Office
Excel Makro
Frage von maloh1984Microsoft Office4 Kommentare

Hallo Habe ein Problem, ein Kunde der hat Excellisten mit Makro die lassen sich öffnen aber die Buttons reagieren ...

Microsoft Office
Funktion SVERWEIS mit Excel
gelöst Frage von HevidarMicrosoft Office6 Kommentare

Hallo, Ich möchte mit Hilfe der Funktion SVERWEIS die Noten berechnen lassen. Leider klappt es nicht richtig. 1+ 15 1 14 ...

Microsoft Office
EXCEL hilft vielleicht SVERWEIS?
gelöst Frage von cambutchaMicrosoft Office9 Kommentare

Hallo zusammen, ich würde gerne folgendes tun, die Daten von Blatt 1 Spalte A mit Spalte A von Blatt ...

Neue Wissensbeiträge
Windows Mobile

Support für Windows Mobile endet im Dezember 2019

Information von transocean vor 18 StundenWindows Mobile

Moin, Microsoft empfiehlt als Alternative den Umstieg auf iOS oder Android, wie man hier lesen kann. Gruß Uwe

Internet

Kommentar: Bundesregierung erwägt Ausschluss von Huawei im 5G-Netz - Unsere Presse wird immer sensationsgieriger

Information von Frank vor 2 TagenInternet5 Kommentare

Hier mal wieder ein schönes Beispiel für fehlgeleiteten Journalismus und Politik zugleich. Da werden aus Gerüchten plötzlich Fakten, da ...

Windows 10

Netzwerk-Bug in allen Windows 10-Versionen durch Januar 2019-Updates

Information von kgborn vor 2 TagenWindows 101 Kommentar

Nur ein kurzer Hinweis für Admins, die Windows 10-Clients im Portfolio haben. Mit den Updates vom 8. Januar 2019 ...

Windows 10

Windows 10 V1809: Rollout ist gestartet - kommt per Windows Update

Information von kgborn vor 3 TagenWindows 102 Kommentare

Eine kurze Information für die Admins, die Windows 10 im Programm haben. Microsoft hat die letzte Baustelle (die Inkompatibilität ...

Heiß diskutierte Inhalte
TK-Netze & Geräte
TAPI auf einem Win2016Server installieren und einrichten
Frage von wstabelTK-Netze & Geräte32 Kommentare

Hallo liebe Admins, ich habe folgende Situation: 1 Windows Server 2016 Standard als DC 1 SNOM 710 IP-Telefon 1 ...

Off Topic
Darf ich ein Forum erstellen das Produkte eines Herstellers betrifft?
Frage von cyberwallOff Topic9 Kommentare

Hallo Community, ich habe da eine "rechtliche" bzw. allgemeine Frage zum erstellen von Foren. Darf ich als "normale Person" ...

DNS
SFTP über DynDNS nicht OK - über ext. IP funktioniert es
Frage von C.MorgensternDNS8 Kommentare

Hallo zusammen! Ich habe Probleme beim SFTP Zugriff auf eine Linux Maschine vom WAN aus über eine DynDNS Adresse. ...

Router & Routing
Unbekannte IPv4 Adresse im Routerprotokoll(Portweiterleitung)
gelöst Frage von tklustigRouter & Routing7 Kommentare

Hallo Leute, folgender Screenshot(ScanVersusPortForwarding.jpg) zeigt die im Routerprotokoll aufgezeigten Portweiterleitungen und alle von einem IPScanner eruierten IPv4 Adressen in ...