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 电子表格