Private Sub CommandButton1_Click()
On Error Resume Next
Application.ScreenUpdating = False
If Workbooks.Count = 1 Then MsgBox "请打开你要操作的目标工作簿", , "提示": Exit Sub
For i = 1 To Workbooks.Count
If Workbooks(i).Name <> ThisWorkbook.Name Then
If MsgBox("你要操作的是“" & Workbooks(i).Name & "”工作表吗?", vbYesNo, "提示") = vbYes Then
WKBK = Workbooks(i).Name
Exit For
End If
End If
Next
If WKBK = "" Then MsgBox "你没有选择任何工作簿": Exit Sub
With Workbooks(WKBK)
For i = 1 To .Sheets.Count
If .Sheets(i).Name = "Macro" Then
.Sheets(i).Range("A1:B13").Clear
GoTo ExistMacro
End If
Next i
.Sheets.Add Type:=xlExcel4MacroSheet
.ActiveSheet.Name = "Macro"
ExistMacr
On Error Resume Next
Application.ScreenUpdating = False
If Workbooks.Count = 1 Then MsgBox "请打开你要操作的目标工作簿", , "提示": Exit Sub
For i = 1 To Workbooks.Count
If Workbooks(i).Name <> ThisWorkbook.Name Then
If MsgBox("你要操作的是“" & Workbooks(i).Name & "”工作表吗?", vbYesNo, "提示") = vbYes Then
WKBK = Workbooks(i).Name
Exit For
End If
End If
Next
If WKBK = "" Then MsgBox "你没有选择任何工作簿": Exit Sub
With Workbooks(WKBK)
For i = 1 To .Sheets.Count
If .Sheets(i).Name = "Macro" Then
.Sheets(i).Range("A1:B13").Clear
GoTo ExistMacro
End If
Next i
.Sheets.Add Type:=xlExcel4MacroSheet
.ActiveSheet.Name = "Macro"
ExistMacr
With .Sheets("Macro")
.Range("A1").FormulaR1C1 = "=ERROR(TRUE,R5C1)"
.Range("A2").FormulaR1C1 = "=RUN(""NoRunMacro"")"
.Range("A3").FormulaR1C1 = "=RETURN()"
.Range("A5").FormulaR1C1 = "=IF(ERROR.TYPE(R2C1)=4)"
.Range("A6").FormulaR1C1 = "=ALERT(""对不起!由于你未启用宏,本文件即将关闭!"",3)"
.Range("A7").FormulaR1C1 = "=FILE.CLOSE(FALSE)"
.Range("A8").FormulaR1C1 = "=RETURN()"
.Range("A9").FormulaR1C1 = "=ELSE()"
.Range("A10").FormulaR1C1 = "=ERROR(TRUE)"
.Range("A11").FormulaR1C1 = "=RETURN()"
.Range("A12").FormulaR1C1 = "=END.IF()"
.Cells.Font.ColorIndex = 2
.Columns("A:IV").EntireColumn.Hidden = True
.Rows("1:65536").EntireRow.Hidden = True
End With
.Sheets("Macro").Visible = xlVeryHidden
For i = 1 To .Sheets.Count
.Sheets(i).Names.Add Name:="Auto_Activate", RefersToR1C1:="=Macro!R1C1"
.Sheets(i).Names("Auto_Activate").Visible = False
Next i
End With
MsgBox "恭喜你:" & vbLf & vbLf & "已为“" & WKBK & "”增加了“不启用宏就关闭工作簿”的功能!" & vbLf & vbLf & " 你可以保存“" & WKBK & "”后再打开试试!" & vbLf & vbLf & "(你至少要为“" & WKBK & "”写一点VBA代码,否则看不到效果。)", , "提示"
Unload Me
Application.ScreenUpdating = True
End Sub
.Range("A1").FormulaR1C1 = "=ERROR(TRUE,R5C1)"
.Range("A2").FormulaR1C1 = "=RUN(""NoRunMacro"")"
.Range("A3").FormulaR1C1 = "=RETURN()"
.Range("A5").FormulaR1C1 = "=IF(ERROR.TYPE(R2C1)=4)"
.Range("A6").FormulaR1C1 = "=ALERT(""对不起!由于你未启用宏,本文件即将关闭!"",3)"
.Range("A7").FormulaR1C1 = "=FILE.CLOSE(FALSE)"
.Range("A8").FormulaR1C1 = "=RETURN()"
.Range("A9").FormulaR1C1 = "=ELSE()"
.Range("A10").FormulaR1C1 = "=ERROR(TRUE)"
.Range("A11").FormulaR1C1 = "=RETURN()"
.Range("A12").FormulaR1C1 = "=END.IF()"
.Cells.Font.ColorIndex = 2
.Columns("A:IV").EntireColumn.Hidden = True
.Rows("1:65536").EntireRow.Hidden = True
End With
.Sheets("Macro").Visible = xlVeryHidden
For i = 1 To .Sheets.Count
.Sheets(i).Names.Add Name:="Auto_Activate", RefersToR1C1:="=Macro!R1C1"
.Sheets(i).Names("Auto_Activate").Visible = False
Next i
End With
MsgBox "恭喜你:" & vbLf & vbLf & "已为“" & WKBK & "”增加了“不启用宏就关闭工作簿”的功能!" & vbLf & vbLf & " 你可以保存“" & WKBK & "”后再打开试试!" & vbLf & vbLf & "(你至少要为“" & WKBK & "”写一点VBA代码,否则看不到效果。)", , "提示"
Unload Me
Application.ScreenUpdating = True
End Sub