如何在同结构新工作簿中手动运行现有休假计算VBA代码？

你可以通过以下几种方式，让你的休假计算VBA代码在每月收到的新工作簿中运行：

方法1：将代码保存为Excel加载项（推荐，一劳永逸） #

把代码做成加载项后，每次打开Excel都会加载该宏，任何符合结构的工作簿都能直接运行：

• 打开任意Excel文件，按Alt+F11打开VBA编辑器
• 右键点击VBAProject，选择「插入」→「模块」
• 将你的完整代码粘贴到模块中
• 点击「文件」→「另存为」，保存类型选择「Excel加载项(*.xlam)」，Excel会自动定位到默认加载项文件夹，直接保存即可
• 关闭并重新打开Excel，点击「文件」→「选项」→「加载项」，在「管理」下拉选「Excel加载项」，点击「转到」，勾选你刚才保存的加载项，确定启用
• 打开新的休假工作簿，按Alt+F8调出宏对话框，选择CopyAndHideDataForJanuary运行即可

注意：原代码中的ThisWorkbook需要替换为ActiveWorkbook，否则代码会操作加载项文件而非当前打开的新工作簿。所有涉及工作簿引用的地方都要做此替换。

方法2：手动导入代码到新工作簿 #

如果不想用加载项，每次收到新工作簿时手动导入：

• 打开新工作簿，按Alt+F11打开VBA编辑器
• 插入新模块，粘贴完整代码
• 按Alt+F8选择CopyAndHideDataForJanuary运行

方法3：批量处理宏（从现有工作簿批量处理新文件） #

如果你需要一次性处理多个新工作簿，可以在保存代码的原工作簿中添加以下宏，自动打开目标工作簿并执行代码：

Sub BatchProcessNewWorkbooks()
    Dim targetWB As Workbook
    Dim filePath As String
    
    '选择要处理的工作簿
    filePath = Application.GetOpenFilename("Excel文件 (*.xlsx;*.xls), *.xlsx;*.xls", , "选择要处理的休假工作簿")
    
    If filePath = "False" Then Exit Sub
    
    Set targetWB = Workbooks.Open(filePath)
    
    '将代码导入目标工作簿
    Dim newMod As Object
    Set newMod = targetWB.VBProject.VBComponents.Add(vbext_ct_StdModule)
    '这里粘贴你的完整代码，注意替换ThisWorkbook为targetWB
    newMod.CodeModule.AddFromString _
        "Public Sub CopyAndHideDataForJanuary()" & vbCrLf & _
        "Call CopyDataFromMultipleSheets" & vbCrLf & _
        "Call HideNonSaturdayColumns" & vbCrLf & _
        "End Sub" & vbCrLf & _
        '以下粘贴你原代码的CopyDataFromMultipleSheets和HideNonSaturdayColumns完整内容，替换ThisWorkbook为targetWB
    
    '运行宏
    targetWB.Application.Run "CopyAndHideDataForJanuary"
    
    '保存并关闭
    targetWB.Save
    targetWB.Close
End Sub

适配跨工作簿运行的完整代码 #

Public Sub CopyAndHideDataForJanuary()
Call CopyDataFromMultipleSheets
Call HideNonSaturdayColumns
End Sub

Sub CopyDataFromMultipleSheets()
Dim ws As Worksheet
Dim newWs As Worksheet
Dim lastRow As Long
Dim startDate As Date
Dim endDate As Date
Dim currentDate As Date
Dim currentCol As Long
Dim monthName As String
Dim formulaRange As Range

'Calculate start and end dates for current month
startDate = DateSerial(Year(Date), Month(Date), 26)
endDate = DateSerial(Year(Date), Month(Date) + 1, 25)

'Create a new worksheet named "All Data"
 monthName = Format(Date, "mmm")
 Set newWs = ActiveWorkbook.Worksheets.Add(After:= _
         ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
 newWs.Name = monthName & "_All_Data"

'Copy headers from Sheet1
 ActiveWorkbook.Worksheets("Sheet1").Range("C5:AG5").Copy newWs.Range("C1")

'Format headers
newWs.Range("A1").Value = "Employee Code"
newWs.Range("A1").EntireColumn.ColumnWidth = 15
newWs.Range("B1").Value = "Name"
newWs.Range("B1").EntireColumn.ColumnWidth = 25
newWs.Range("AJ1").Value = "Leaves Taken"
newWs.Range("AK1").Value = "Carry Forward"
newWs.Range("AL1").Value = "Balance Leaves Feb"

Set formulaRange = newWs.Range("AJ2:AJ500")
formulaRange.Formula = "=IF(A2=""""",""""",SUMPRODUCT(((WEEKDAY($C$1:$AG$1)=7)*((C2:AG2=""L(CL)""))+(C2:AG2=""A""))+(C2:AG2=""WO"")))))"
Set formulaRange = newWs.Range("AK2:AK500")
formulaRange.Formula = "=AJ2-2"

'Format date columns
currentCol = 3
currentDate = startDate
While currentDate <= endDate
    newWs.Cells(1, currentCol).Value = currentDate
    newWs.Cells(1, currentCol).NumberFormat = "dd/mm/yyyy"
    currentDate = currentDate + 1
    currentCol = currentCol + 1
Wend

'Copy data from each sheet named like "Sheet1", "Sheet2", etc.
For Each ws In ActiveWorkbook.Worksheets
    If Left(ws.Name, 5) = "Sheet" Then
        lastRow = newWs.Cells(Rows.Count, 1).End(xlUp).Row
        newWs.Range("A" & lastRow + 1).Value = ws.Range("F3").Value
        newWs.Range("B" & lastRow + 1).Value = ws.Range("O3").Value
        newWs.Range("C" & lastRow + 1 & ":AG" & lastRow + 1).Value = ws.Range("C14:AG14").Value
    End If
Next ws

'Update date range for next month
startDate = DateSerial(Year(Date), Month(Date) - 1, 26)
endDate = DateSerial(Year(Date), Month(Date), 25)
currentCol = 3
currentDate = startDate
While currentDate <= endDate
    newWs.Cells(1, currentCol).Value = currentDate
    newWs.Cells(1, currentCol).NumberFormat = "ddd, mmm dd"
    currentDate = currentDate + 1
    currentCol = currentCol + 1
Wend

With newWs.Range("A1:AZ1")
   .Font.Size = 11 ' Increase font size to 11
   .Font.Bold = True ' Make headers bold
End With
newWs.Columns("AJ").ColumnWidth = 15
newWs.Columns("AK").ColumnWidth = 19
newWs.Columns("AL").ColumnWidth = 19
End Sub


Sub HideNonSaturdayColumns()
Dim ws As Worksheet
Dim rng As Range
Dim lastCol As Long
Dim monthName As String

monthName = Format(Date, "mmm") 'Get current month name

'Loop through all worksheets
For Each ws In ActiveWorkbook.Worksheets
    If InStr(1, ws.Name, monthName) > 0 Then 'Only hide columns in sheets containing the current month name
        'Find the last column in row 1
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        
        'Loop through all columns in row 1
        For Each rng In ws.Range(ws.Cells(1, 3), ws.Cells(1, lastCol))
            'Hide the column if it's not a Saturday
            If IsDate(rng.Value) And Weekday(rng.Value) <> 7 Then
                rng.EntireColumn.Hidden = True
            Else
                rng.EntireColumn.Hidden = False
            End If
        Next rng
    End If
Next ws
End Sub

内容的提问来源于stack exchange，提问作者Vansh Shah