VBA：保存電子表格

Question

我是 VBA 的初學者，我想知道我的代碼是否有效。 我想知道這太長了，也許有一些 function 來保存電子表格？

我是這樣進行的：

1. 我點擊按鈕（代碼運行 Userform“Edition Fichier”），我的代碼中這個 Userforme 的名稱是 uSauvegarde。

2. 我做出我的選擇：

3. 代碼是：

    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

謝謝您的幫助 ！

Answer 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