excel - Excel宏中的循环

Question

我有以下代码。问题是：我想从插入左侧标题的图像文件中更改图像大小，并且循环在 2 个文件后停止。我找不到我的问题：

如何设置图像大小以及如何将更改应用于文件夹中的每个文件？

Sub LoopAllExcelFilesInFolder()
'ALLE XLS FILES AUTOMATISCH MODIFIZIEREN'
'VARIABLEN'
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim ImagePath As String
Dim Validation As String

'PFAD ZUM KUNDENLOGO
  ImagePath = "C:\logo.jpg"
'FIRMENNAME'
  companyname = "FIRMENNAME"
'AUFTRAGSNUMMER'
  contractnumber = "23-23"

'Geschwindigkeitsoptimierung
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Ordnerauswahl
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'Bei Abbruch
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Dateiendung (XLS)
  myExtension = "*.xls*"
'Dateiendung (XLS)
  myExtension2 = "*.xlsx*"


'Zielordner mit Endung xls
  myFile = Dir(myPath & myExtension)
'Zielordner mit Endung xlsx
  myFile2 = Dir(myPath & myExtension2)

xls 文件的循环：

'Loop durch alle XLS Files
  Do While myFile <> ""
    'Variable wird umbenannt
      Set wb = Workbooks.Open(Filename:=myPath & myFile)

    'Warten bis Worksheet geöffnet ist
      DoEvents

    'CODE FÜR ÄNDERUNGEN
    'PRÜFEN OB LOGO EXISTIERT
      On Error Resume Next
        Validation = Dir(ImagePath)
      On Error GoTo 0

      If Validation = "" Then
        MsgBox "Pfad zu Logo falsch: " & ImagePath
        Exit Sub
      End If

    'LOGO IN JEDES AKTIVE SHEET EINFÜGEN
      For Each sheet In ActiveWorkbook.Worksheets
        sheet.activate
        'VARIABLEN FÜR SHEET POSITIONS ("LeftFooter","CenterFooter","RightFooter", "LeftHeader","CenterHeader","RightHeader")
          sheet.PageSetup.LeftHeader = "&G"
          sheet.PageSetup.LeftHeaderPicture.Filename = ImagePath
          sheet.PageSetup.LeftFooter = "&""Arial,Standard""&10&F © " + companyname + ", Vertragsnummer: " + contractnumber
          sheet.DisplayPageBreaks = False

      Next sheet

    'Speichern und schliessen
      wb.Close SaveChanges:=True

    'Warten bis workbook geschlossen ist
      DoEvents

    'Nächstes File
      myFile = Dir
  Loop

所有 xlsx 文件的循环：

' LOOP DURCH ALLE XLSX FILES'
  Do While myFile2 <> ""
    'Variable wird umbenannt
      Set wb = Workbooks.Open(Filename:=myPath & myFile2)

    'Warten bis Worksheet geöffnet ist
      DoEvents

    'CODE FÜR ÄNDERUNGEN
    'PRÜFEN OB LOGO EXISTIERT
      On Error Resume Next
        Validation = Dir(ImagePath)
      On Error GoTo 0

      If Validation = "" Then
        MsgBox "Pfad zu Logo falsch: " & ImagePath
        Exit Sub
      End If

    'LOGO IN JEDES AKTIVE SHEET EINFÜGEN
      For Each sheet In ActiveWorkbook.Worksheets
        sheet.activate
        'VARIABLEN FÜR SHEET POSITIONS ("LeftFooter","CenterFooter","RightFooter", "LeftHeader","CenterHeader","RightHeader")
          sheet.PageSetup.LeftHeader = "&G"
          sheet.PageSetup.LeftHeaderPicture.Filename = ImagePath
          sheet.PageSetup.LeftFooter = "&""Arial,Standard""&10&F © " + companyname + ", Vertragsnummer: " + contractnumber
          sheet.DisplayPageBreaks = False

      Next sheet

    'Speichern und schliessen
      wb.Close SaveChanges:=True

    'Warten bis workbook geschlossen ist
      DoEvents

    'Nächstes File
      myFile2 = Dir
  Loop

'Message Box
  MsgBox "Fertig"

ResetSettings:
  'Reset Optimierungen
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

标签： excelvba