excel - VBA:保存电子表格
问题描述
我是 VBA 的初学者,我想知道我的代码是否有效。我想知道这太长了,也许有一些功能可以保存电子表格?
我是这样进行的:
- 我点击按钮(代码运行 Userform“Edition Fichier”),我的代码中这个 Userforme 的名称是 uSauvegarde。
- 我做出选择:
代码是:
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
谢谢您的帮助 !
解决方案
您的代码对我来说看起来不错,但我发现一些没有任何意义的东西,例如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
推荐阅读
- java - (可能)自定义 ThreadPoolExecutor 的内存泄漏
- ajax - 如何使用 console.log 打印 JSON
- tensorflow - tensorflow 配置文件解释
- android - 保存动态添加的视图
- python - 如何在循环中每次将新列提供给 spark 数据框?
- scala - HBaseTableCatalog.tableCatalog 显示错误 - Symbol 'term
类路径中缺少 .yetus.audience'。如何解决这个问题? - php - Typo3 8.7:通过 redirect() 在动作之间传递数据不起作用
- html - Flex Child Height 未拉伸到父级的全高(使用 align-self 拉伸)
- javascript - Can't receive my js and css files with Webpack DevServer
- scala - 在播放框架中创建可写到 HTTP 响应