excel - Excel XLSM 文件问题
问题描述
我创建了一个启用宏的工作簿,其中包含一个用于收集特定数据的工作表。VBA 项目受密码保护,工作表也受密码保护。文件大小约为 3 Mb。
现在数据是从大约 20 名团队成员那里收集的。我正在准备一份摘要表,并试图将所有单独的表放入一个工作簿中。
移动或复制工作簿导致 Excel 挂起。
任何想法将不胜感激。
这是工作簿中的代码:
Sub Open_SA()
' Open_SA Macro
' Open Appraisal Form for Self Appraisal
'Get Password
Dim MyPassword As String
MyPassword = "********"
If InputBox("You are not authorized. Please enter password to continue.", "Enter Password") <> MyPassword Then
Exit Sub
End If
'Unlock Sheet
Sheets(1).Select
ActiveSheet.Unprotect Password:="********"
'Lock and hide all cells
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = True
'Select SA related cells and Unlock
Range("C6:Z14,C17:Z25,C28:Z36,C39:Z47,W55:X60,W64:X75,W79:X81,A87:H87").Select
Selection.Locked = False
Selection.FormulaHidden = False
'Select L1 related cells and change the font color to background color
Range( _
"AB7:AD9,AB18:AD20,AB29:AD31,AB40:AD42,Z55:AA60,Z64:AA75,Z79:AA81,L87:S87"). _
Select
With Selection.Font
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.599993896298105
End With
'Select L2 related cells and change the font color to background color
Range( _
"AB12:AD14,AB23:AD25,AB34:AD36,AB45:AD47,AC55:AD60,AC64:AD75,AC79:AD81,W87:AD87"). _
Select
With Selection.Font
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.599993896298105
End With
'Hide Evaluation Cells
Range("AF85:AM93").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Activate specific cell range
Range("C6:Z6").Select
'Lock Sheet
Sheets(1).Select
ActiveSheet.Protect Password:="********", DrawingObjects:=True, Contents:=True, Scenarios:= _
True
'Save workbook
ActiveWorkbook.Save
End Sub
这是模块之一。有类似的4个模块。
另一个模块:
Sub Open_L1()
' Open_L1 Macro
' Open Appraisal Form for L1 Rating
'Get Password
Dim MyPassword As String
MyPassword = "********"
If InputBox("You are not authorized. Please enter password to continue.", "Enter Password") <> MyPassword Then
Exit Sub
End If
'Unlock Sheet
Sheets(1).Select
ActiveSheet.Unprotect Password:="********"
'Lock and hide all cells
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = True
'Select L1 related cells, Unlock cells and Set font color to automatic
Range( _
"AB7:AD9,AB18:AD20,AB29:AD31,AB40:AD42,Z55:AA60,Z64:AA75,Z79:AA81,L87:S87"). _
Select
Selection.Locked = False
Selection.FormulaHidden = True
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
'Select L2 related cells and change the font color to background color
Range( _
"AB12:AD14,AB23:AD25,AB34:AD36,AB45:AD47,AC55:AD60,AC64:AD75,AC79:AD81,W87:AD87"). _
Select
With Selection.Font
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.599993896298105
End With
'Hide Evaluation Cells
Range("AF85:AM93").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Activate specific cell range
Range("AB7:AD9").Select
'Lock Sheet
Sheets(1).Select
ActiveSheet.Protect Password:="********", DrawingObjects:=False, Contents:=True, Scenarios:= _
False
'Save workbook
ActiveWorkbook.Save
End Sub
这是第 2 步。
其他模块也这样做。
一般结构是: 1. 获取密码 2. 解锁工作表 3. 选择特定范围的单元格并执行操作,例如使它们可见、更改字体颜色或使它们隐藏 4. 锁定工作表 5. 保存工作簿。
解决方案
推荐阅读
- javascript - 我想在 JavaScript 中将此字符串(2020 年 11 月 30 日星期一 08:54 PM)转换为 30-11-2020 日期格式,请帮帮我
- mysql - 如何从mysql数据库的多个表中查询
- c++ - 重载赋值运算符的困惑 =
- javascript - getByRole 用于测试库中 li > a 下的文本
- javascript - Jave Script 格式值日期添加前导 0 到小时
- reactjs - 在 Bluehost 等共享服务器上部署和运行带有 react 网站的 Laravel
- android-studio - 用于 react-native 的 Android Studio 编辑器
- python - 带有 Homebrew 的多个 Python 版本
- airflow - 气流:在单个 DAG 文件中导入装饰任务与所有任务?
- string - 如何查找子字符串在给定字符串中出现的次数(包括连接)?