Makro auf alle Excel-Dateien anwenden ohne jede einzige aufm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub ProvaDir() Dim fName As String Dim wbk As Workbook Dim myPath As String myPath = "C:\Users\MM\Desktop\Neuer Ordner\Progetto Powerpoint-Excel\Menu Excel\Donnerstag-kopie\" fName = Dir(myPath) Application.ScreenUpdating = False Do While fName > "" With Workbooks.Open(myPath & fName) With .ActiveSheet .Shapes.Range(Array("Picture 1")).Delete .Rows("2:3").Delete Shift:=xlUp .Rows("5:7").Delete Shift:=xlUp .Range("A5").UnMerge .Range("B1").Select End With .Close SaveChanges:=True End With fName = Dir() Loop Application.ScreenUpdating = True End Sub

ok, ich vermute einmal, dass in deinem Ordner nicht nur Excel-Dateien sind...
Vielleicht versuchst du mal das folgende.
Da musst du aber evtl die Dateierweiterung richtig einstellen. Siehe Kommentare.
Falls das nicht funktioniert, solltest du uns sagen können, inwieweit du Message Boxes bekommen hast und was die sagten.
Darüber hinaus kannst du ggf. auch im Direktfenster die Ausgabe von Debug.Print finden.





Sub ProvaDir()

    

    Dim colPaths As Collection

    Dim myPath As String

    Dim filePath As Variant

    

    myPath = "C:\Users\MM\Desktop\Neuer Ordner\Progetto Powerpoint-Excel\Menu Excel\Donnerstag-kopie"

   

    ' set here the type of Excel file you want to work on, current setting is "xlsx"   

    Set colPaths = findFilesInFolderByExt(myPath, "xlsx")

    

    If colPaths.Count = 0 Then

        MsgBox "no item found"

        Exit Sub

    End If



    'MsgBox just for debugging

    MsgBox colPaths.Count & " File(s) found"



    Application.ScreenUpdating = False

    For Each filePath In colPaths

        With Workbooks.Open(filePath)

            With .ActiveSheet

                .Shapes.Range(Array("Picture 1")).Delete

                .Rows("2:3").Delete Shift:=xlUp

                .Rows("5:7").Delete Shift:=xlUp

                .Range("A5").UnMerge

                .Range("B1").Select

            End With

            .Close SaveChanges:=True

        End With

        Debug.Print filePath

    Next

    set colPaths = Nothing

    Application.ScreenUpdating = True    



End Sub



Private Function findFilesInFolderByExt(ByVal SourceFolderName As String, ByVal fileExtension As String, _

                                        Optional includeSubfolders As Boolean = False) As Collection

  

  'Returns a Collection with file pathes of extension fileEtension starting at path SourceFolderName

  'for includeSubFolders = True the search includes subfolders

  'except System and Hidden folders as well as folders without read access.

  

  Dim fso As Object, SourceFolder As Object, SubFolder As Object

  Dim FileItem

  Dim Result As New Collection

  Dim i As Long, j As Long, x

  

  

  Set fso = CreateObject("Scripting.FileSystemObject")

    

  If fso.GetDrive(fso.GetDriveName(SourceFolderName)).path = SourceFolderName Then

    Set SourceFolder = fso.GetDrive(fso.GetDriveName(SourceFolderName)).RootFolder

  Else

    Set SourceFolder = fso.GetFolder(SourceFolderName)

  End If



  'check for ReadAccess

  On Error Resume Next

  If Not (SourceFolder.Files.Count >= 0) Then

    Exit Function

  End If

  On Error GoTo 0



  For Each FileItem In SourceFolder.Files

    If LCase(fso.GetExtensionName(FileItem.path)) = LCase(fileExtension) Then

       Result.Add FileItem.path

       Exit For

    End If

  Next FileItem

  

  DoEvents

    

  If includeSubfolders Then

    For Each SubFolder In SourceFolder.SubFolders

      If Not ((SubFolder.Attributes And (vbSystem Or vbHidden)) > 0) Then

        Dim SubResult As Collection

        Set SubResult = findFilesInFolderByExt(SubFolder.path, fileExtension, True)

        If SubResult.Count > 0 Then

            For Each x In SubResult

               Result.Add x

            Next

        End If

        Set SubResult = Nothing

      End If

    Next SubFolder

  End If

  

  Set findFilesInFolderByExt = Result



End Function

Also, Ich habe jetzt eine Exceldatei erstellt, die du bitte in den Ordner speicherst der deine Beispieldateien enthält.
Der Ordner soll NUR diese zu ändernden Excel-Dateien enthalten und dieses .XLSM
Dann kannst du die XLSM starten, das Makro über den Button ausführen und anschließend schauen, ob das Ergebnis passt.

Leider habe ich nach wie vor nicht verstanden, was du genau erreichen willst.
Das Shape, das gelöscht werden soll, befindet sich in keiner deiner Beispieldateien.
Die Zeilen, in der verbundene Zellen stehen werden eigentlich gelöscht.
Du sagst wieder, dass die Dateien nicht geöffnet werden sollen.
Um die Änderungen auszuführen, muß das Makro aber natürlich die Dateien öffnen und dann wieder schließen.
Wenn wir damit jetzt nicht weiter kommen, muss ich es wahrscheinlich tatsächlich aufgeben.

https://www.herber.de/bbs/user/167214.xlsm

Ho creato un file Excel che dovete salvare nella cartella che contiene i vostri file di esempio.
La cartella deve contenere solo i file Excel da modificare e questo file .XLSM.
Quindi è possibile avviare l'XLSM, eseguire la macro utilizzando il pulsante e vedere se il risultato è corretto.

Purtroppo non ho ancora capito cosa volete ottenere esattamente.
La "shape" da eliminare non è presente in nessuno dei file di esempio.
Le righe contenenti le celle collegate vengono effettivamente eliminate.
Ancora una volta, state dicendo che i file non devono essere aperti.
Tuttavia, per apportare le modifiche, la macro deve ovviamente aprire i file e poi richiuderli.
Se non si va oltre, probabilmente dovrò arrendermi.

Beliebteste Forumthreads (12 Monate)

Makro auf alle Excel-Dateien anwenden ohne jede einzige aufm

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro auf alle Excel-Dateien anwenden ohne jede einzige aufm

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread