`
binyan17
  • 浏览: 200999 次
  • 性别: Icon_minigender_1
  • 来自: 重庆
社区版块
存档分类
最新评论

VBS操作Excel添加宏表

阅读更多
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
    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
分享到:
评论

相关推荐

Global site tag (gtag.js) - Google Analytics