VBA - 保存工作簿 1 后对工作簿 2 的操作

Question

所以，这是我的问题：我在 VBA 中有一个宏，它删除了我工作表中的所有隐藏列。 它工作正常。

Sub Test()
Dim F As Integer, C As Integer
For F = 1 To Sheets.Count
    ActiveSheet.Select
    For C = 15 To 2 Step -1
        ActiveSheet.Columns(C).Select
        Selection.End(xlDown).Select
        derniereligne = ActiveCell.Row
        If ActiveSheet.Columns(C).Hidden = True Then
            ActiveSheet.Columns(C).Delete
        End If
    Next C
Next F
End Sub

但是现在，我的项目发展了，我必须将我的工作簿保存在副本上，所以我做到了：

Sub SaveXL()

Dim Nom2 As String
Dim Jour2 As String
Dim FPath2 As String
Jour2 = Format(Now(), "yyyymmdd - h\hmm'")
Nom2 = Jour2 & " Pricelist"
FPath2 = Sheets("PARAM").Range("B33").Value
On Error GoTo fin4
fichier = Application.GetSaveAsFilename(FPath2 & Nom2, "Fichiers Excel (*.xls), *.xls")
ActiveWorkbook.SaveCopyAs fichier
Exit Sub
fin4:MsgBox "La création de l'excel a échoué"
End Sub

它为我创建了一个副本，好的。 但是当我使用第二个宏 (SaveXL) 保存时，我想在我的第一个工作簿 (Workbook 2) 的副本上使用第一个宏 (Test)。

是否可以 ？ 提前致谢 ！

Answer 1

在 SaveXL 调用 Test 并传递复制的工作簿的名称：

fichier = Application.GetSaveAsFilename(FPath2 & Nom2, "Fichiers Excel (*.xls), *.xls")
ActiveWorkbook.SaveCopyAs fichier
Test Nom2

在测试中检查目标工作簿是否已打开。 如果未打开，请打开，运行宏并关闭它，保存更改等于 True：

Sub Test(targetWorkbookName As String)
    Dim F As Integer, C As Integer, derniereligne

    Dim targetWorkbook As Workbook
    On Error Resume Next
    Set targetWorkbook = Workbooks(targetWorkbookName)
    On Error GoTo 0
    If (targetWorkbook Is Nothing) Then _
        Set targetWorkbook = Workbooks.Open(targetWorkbookName)

    For F = 1 To Sheets.Count
        ActiveSheet.Select
        For C = 15 To 2 Step -1
            ActiveSheet.Columns(C).Select
            Selection.End(xlDown).Select
            derniereligne = ActiveCell.Row
            If ActiveSheet.Columns(C).Hidden = True Then
                ActiveSheet.Columns(C).Delete
            End If
        Next C
    Next F

    targetWorkbook.Close savechanges:=True
End Sub

希望我理解正确。 HTH

Answer 2

您可以将工作簿作为参数传递给子 Test()。 因此，在保存工作簿后，在新工作簿中运行测试子程序。 看看我在你的 Test() 代码中所做的修改：

'Here I insert a parameter to your sub
Sub Test(myWorkBook as Workbook)
    Dim F As Integer, C As Integer
    For F = 1 To myWorkBook.worksheets.Count
        'ActiveSheet.Select
        For C = 15 To 2 Step -1
            myWorkBook.worksheets(f).Columns(C).Select
            Selection.End(xlDown).Select
            derniereligne = ActiveCell.Row
            If myWorkBook.worksheets(f).Columns(C).Hidden = True Then
                myWorkBook.worksheets(f).Columns(C).Delete
            End If
        Next C
    Next F
End Sub

现在你的子 saveXL()

Sub SaveXL()
    Dim Nom2 As String
    Dim Jour2 As String
    Dim FPath2 As String
    Jour2 = Format(Now(), "yyyymmdd - h\hmm'")
    Nom2 = Jour2 & " Pricelist"
    FPath2 = Sheets("PARAM").Range("B33").Value
    On Error GoTo fin4
    fichier = Application.GetSaveAsFilename(FPath2 & Nom2, "Fichiers Excel (*.xls), *.xls")
    ActiveWorkbook.SaveCopyAs fichier
    call test(ActiveWorkbook) '<-- here you use your Test() sub
    Exit Sub
    fin4:MsgBox "La création de l'excel a échoué"
End Sub

PS：对不起我的英语