VBA – 在保存工作簿后对工作簿2执行操作1

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

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 

它创造了一个副本，好的。 但是，我想用第二个macros（SaveXL）保存时，我的第一个工作簿（工作簿2）的副本上使用第一个macros（testing）。

可能吗 ？ 提前致谢 ！

Answer 1

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

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

在testing中检查目标工作簿是否打开。 如果未打开，请打开，运行macros并使用等于True的保存更改closures它：

 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

您可以将工作簿作为parameter passing给Test（）。 所以，当您保存工作簿后，您在新的工作簿中运行testing子。 看看我在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：对不起，我的英文