在打开的工作簿中,如何执行从打开的工作簿开始的循环,打开,更新,保存和关闭其他工作簿?

时间:2019-08-19 11:38:56

标签: excel vba for-loop

我知道如何使用活动工作簿中设置的命名范围在工作簿中的特定工作表列表中循环宏。我试图模拟一个类似的宏,以便从特定的打开的wb通过特定的工作簿列表运行,该工作簿位于同一文件夹中,但以特定的顺序运行。基本上,在通过婴儿工作簿运行循环之前,我需要一些wb来打开,更新,保存更改和关闭。试图使用数组等,但失败了。我确实找到了我以为可以使用的代码,但是循环使我失败了。

我试图调整以下代码,但A)它要求用户输入,但我不想B)我需要按特定顺序遍历一个列表(列表包含wbs的完整路径以覆盖同一文件夹)。找不到路。虽然解决了类似的循环A wb循环特定ws。谢谢!

    Sub LoopAllExcelFilesInFolder()
    'PURPOSE: To loop through all Excel files in a user specified folder 
    and 
   perform a set task on them
   'SOURCE: www.TheSpreadsheetGuru.com

   Dim wb As Workbook
   Dim myPath As String
   Dim myFile As String
   Dim myExtension As String
   Dim FldrPicker As FileDialog

   'Optimize Macro Speed
   Application.ScreenUpdating = False
   Application.EnableEvents = False
   Application.Calculation = xlCalculationManual

   'Retrieve Target Folder Path From User
   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

    'In Case of Cancel
    NextCode:
    myPath = myPath
    If myPath = "" Then GoTo ResetSettings

   'Target File Extension (must include wildcard "*")
   myExtension = "*.xls*"

  'Target Path with Ending Extention
   myFile = Dir(myPath & myExtension)

 'Loop through each Excel file in folder
   Do While myFile <> ""
 'Set variable equal to opened workbook
  Set wb = Workbooks.Open(Filename:=myPath & myFile)

  'Ensure Workbook has opened before moving on to next line of code
  DoEvents

 'Change First Worksheet's Background Fill Blue
  wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

 'Save and Close Workbook
  wb.Close SaveChanges:=True

 'Ensure Workbook has closed before moving on to next line of code
  DoEvents

 'Get next file name
  myFile = Dir
  Loop

'完成任务后的消息框     MsgBox“任务完成!”

    ResetSettings:
   'Reset Macro Optimization Settings
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True

结束子

0 个答案:

没有答案