VBA:保存电子表格

Posted

技术标签:

【中文标题】VBA:保存电子表格【英文标题】:VBA : save the spreadsheet 【发布时间】:2021-03-04 19:17:03 【问题描述】:

我是 VBA 的初学者,我想知道我的代码是否高效。我想知道这太长了,也许有一些功能可以保存电子表格?

我是这样处理的:

    我点击按钮(代码运行Userform“Edition Fichier”),这个Userforme在我的代码中的名字是uSauvegarde。

    我做出选择:​​i>

    代码是:

    Private Sub bParcourir_Click()
    With Application.FileDialog(4)
     .AllowMultiSelect = False
     .Show
     uSauvegarde.TextBox1 = .SelectedItems(1)
     End With
     End Sub
     Private Sub bValider_Click()
     Dim wb_Saisie As Workbook, wb_Sauv As Workbook
     Dim New_Wkb As String, TableDesFeuilles() As String
     Dim i As Integer, NumF As Integer
     Dim S As Worksheet
     Dim obj As Shape
     Dim mdCalc As XlCalculation
     mdCalc = Application.Calculation
     Application.Calculation = xlCalculationManual
     Application.ScreenUpdating = False
     New_Wkb = uSauvegarde.TextBox1 & "\" & uSauvegarde.TextBox2 & ".xlsx"
     Set wb_Saisie = ThisWorkbook
     wb_Saisie.Activate
     i = 0
     For Each S In wb_Saisie.Sheets
     If S.Visible = True Then
         ReDim Preserve TableDesFeuilles(i)
         TableDesFeuilles(i) = S.Name
         i = i + 1
     End If
     Next
     Application.ScreenUpdating = False
     NumF = 0
     BlocageModif = True
     For Each S In wb_Saisie.Sheets
     If S.Visible = True Then
         S.Copy
         ActiveSheet.Cells.Copy
         ActiveSheet.Cells.PasteSpecial xlPasteValues
         If NumF = 0 Then
             Set wb_Sauv = ActiveWorkbook
             NumF = 1
         Else
             ActiveSheet.Move After:=wb_Sauv.Worksheets(NumF)
             NumF = NumF + 1
         End If
         Range("A1").Select
         For i = ActiveSheet.UsedRange.Columns.Count To 1 Step -1
             If ActiveSheet.Columns(i).Hidden = True Then ActiveSheet.Columns(i).Delete
         Next
         For j = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
             If ActiveSheet.Rows(j).Hidden = True Then ActiveSheet.Rows(j).Delete
         Next
         For Each obj In ActiveSheet.Shapes
             If obj.OnAction <> "" Then obj.OnAction = ""
         Next
     End If
     Next S
     For Each NomLocal In wb_Sauv.Names
     If InStr(NomLocal.Name, "Print_") = 0 Then NomLocal.Delete
     Next
     wb_Sauv.SaveAs Filename:= _
     New_Wkb, FileFormat:= _
     xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, 
     CreateBackup:=False
     wb_Sauv.Close
    Application.Calculation = mdCalc
    Application.ScreenUpdating = True
    MsgBox ("Fichier enregistré")
    uSauvegarde.Hide
    End Sub
    Private Sub OptionButton1_Click()
    With ThisWorkbook.Sheets("Feuil1")
     uSauvegarde.TextBox2 = "Mon_fichier"
    End With
    End Sub
    Private Sub OptionButton2_Click()
    uSauvegarde.TextBox2 = ""
    End Sub
    

感谢您的帮助!

【问题讨论】:

【参考方案1】:

您的代码对我来说看起来不错,但我发现了一些没有任何意义的东西,例如创建了更多代码的 With 或关闭了已关闭的屏幕更新。由于缩进不良和缺乏描述性变量名称,代码难以阅读。这在编码时非常重要,因为您极有可能需要再次阅读它以修复可能的错误或提高效率。我做了一些更改供您查看。

Option Explicit '---- always good to have

Private Sub bParcourir_Click()

    With Application.FileDialog(4)
        .AllowMultiSelect = False
        .Show
        uSauvegarde.TextBox1 = .SelectedItems(1)
     End With
     
 End Sub
 
 Private Sub bValider_Click()
 
 Dim wb_Saisie As Workbook, wb_Sauv As Workbook
 Dim New_Wkb As String, TableDesFeuilles() As String
 Dim i As Integer, NumF As Integer
 Dim S As Worksheet
 Dim obj As Shape
 Dim mdCalc As XlCalculation
 
 mdCalc = Application.Calculation
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 
 New_Wkb = uSauvegarde.TextBox1 & "\" & uSauvegarde.TextBox2 & ".xlsx"
 
 Set wb_Saisie = ThisWorkbook
 
 wb_Saisie.Activate
 i = 0
 
 For Each S In wb_Saisie.Sheets
    If S.Visible = True Then
        ReDim Preserve TableDesFeuilles(i)
        TableDesFeuilles(i) = S.Name
        i = i + 1
    End If
 Next
 
 'Application.ScreenUpdating = False ---- why disable "screen updating" again?
 NumF = 0
 BlocageModif = True
 
 With ActiveSheet '----- a "With" here is a good idea
 
 For Each S In wb_Saisie.Sheets
    
    'If S.Visible = True Then
    If S.Visible Then '------- the if statement above can be written like this

        S.Copy
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        
        If NumF = 0 Then
            Set wb_Sauv = ActiveWorkbook
            NumF = 1
        Else
            .Move After:=wb_Sauv.Worksheets(NumF)
            NumF = NumF + 1
        End If
        
        Range("A1").Select
        
        For i = .UsedRange.Columns.Count To 1 Step -1
            
             If .Columns(i).Hidden Then
                t.Columns(i).Delete
             End If
             
        Next
        
        For j = .UsedRange.Rows.Count To 1 Step -1
          
            If .Rows(j).Hidden Then
                .Rows(j).Delete
            End If
            
        Next
        
        For Each obj In .Shapes
    
             If obj.OnAction <> "" Then
                obj.OnAction = ""
            End If
             
        Next
        
    End If
    
 Next S
 
 End With
 
 For Each NomLocal In wb_Sauv.Names
    If InStr(NomLocal.Name, "Print_") = 0 Then NomLocal.Delete
 Next
 
 '------ this section of the code has problems.. check it out
 wb_Sauv.SaveAs Filename:= _
 New_Wkb, FileFormat:= _
 xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False,
 CreateBackup:=False
 
 wb_Sauv.Close

Application.Calculation = mdCalc
Application.ScreenUpdating = True

'MsgBox ("Fichier enregistré") '----- parenthesis are nor necessary
MsgBox "Fichier enregistré"

uSauvegarde.Hide

End Sub

Private Sub OptionButton1_Click()

'With ThisWorkbook.Sheets("Feuil1") ---- this "With" creates more code...
    'uSauvegarde.TextBox2 = "Mon_fichier"
'End With

ThisWorkbook.Sheets("Feuil1").uSauvegarde.TextBox2 = "Mon_fichier"

End Sub

Private Sub OptionButton2_Click()
    uSauvegarde.TextBox2 = ""
End Sub

【讨论】:

谢谢,最好写成: Private Sub OptionButton1_Click() uSauvegarde.TextBox2 = "Mon_fichier" End Sub 我的意思是没有:ThisWorkbook.Sheets("Feuil1")。在“uSauvegarde”的前面 with Option Explicit 我有一个错误,函数 bValider_Click() 中有一些变量,我想知道其中一个,好像我声明了所有变量。非常感谢您的帮助! @Marie 因为我没有文件,所以我很难帮你,但你知道你可以逐行运行代码吗?您可以将光标放在变量上以查看分配了哪些值。在 Windows 中使用 F8,在 Mac 中使用 command + shift + i 另一件事,我修改了 IF 语句。试着像那样写它们。当你写它们时没有 End If 可能会导致一些问题。另外,代码的最后一部分有问题,我在那里写了一些东西,所以你可以找到它。 Option Explicit 如果打扰您,您可以删除它。

以上是关于VBA:保存电子表格的主要内容,如果未能解决你的问题,请参考以下文章

访问 VBA 自动化能够将 Word 文档保存到 Sharepoint 但不能保存到 Excel 电子表格

如何使用 VBA 在 Excel 中添加连接(到外部数据源)并将其保存到该 Excel 电子表格的连接列表

vba中有啥类型的电子表格复选框?

VBA复制行高?

Excel 崩溃,VBA 用户窗体无法保存

在 VBA 中的电子表格对内循环