Question

我创建了一个启用宏的工作簿，其中包含一个用于收集特定数据的工作表。 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.保存工作簿。

Excel XLSM文件问题

0 个答案: