加载宏时，出现：excel 运行时错误 '429' ActiveX部件不能创建对象

小和尚的烂人参

Option Explicit
Public g_nCommand As Integer
Public g_szReport As String
Public g_szUniqueReport As String
Public g_szHtml As String
Public g_nCol As Integer
Public g_nRow As Integer
Sub auto_open()
    Dim DefDlg As New CRepDlg
    g_nCommand = DefDlg.GetCommand()   
    g_szReport = DefDlg.GetRepName()
    g_szHtml = DefDlg.GetHtmlName()
    g_szUniqueReport = DefDlg.GetUniqueReport()
    If (g_nCommand = 0) Then '新建报表定义
        g_nCommand = 1
        If (Workbooks.Count = 0) Then
            Workbooks.Add
        End If
        If (ActiveWorkbook.Sheets.Count = 0) Then
            ActiveWorkbook.Sheets.Add
        End If
        ActiveWorkbook.SaveAs FileName:=g_szReport, FileFormat _
            :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
            False, CreateBackup:=False
    ElseIf (g_nCommand >= 1) Then
        Workbooks.Open g_szReport
    End If
    If (g_nCommand = 1) Then '更改报表定义
        ButtonAction.ShowDefine (True)
    ElseIf (g_nCommand = 2) Then
        ButtonAction.ShowResult
    ElseIf (g_nCommand = 3) Then    'publish
        ButtonAction.ShowResult
        ButtonAction.SaveAsHTML
    ElseIf (g_nCommand = 4) Then    'print
        ButtonAction.ShowResult
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    ElseIf (g_nCommand = 5) Then    'print and publish
        ButtonAction.ShowResult
        ButtonAction.SaveAsHTML
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    End If
   
   
'保存自动生成报表
    If (g_nCommand >= 2) Then
        ActiveWorkbook.SaveAs FileName:=g_szUniqueReport, FileFormat _
            :=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
            False, CreateBackup:=False
    End If
'修改菜单
    If (g_nCommand = 1 Or g_nCommand = 2) Then
        SysInit
    End If
'自动生成报表时，马上退出，不要显示
    If (g_nCommand > 2 And g_nCommand < 6) Then
        ActiveWorkbook.Close False
        Application.Quit
    End If
End Sub
Sub auto_close()
    Application.MenuBars(xlWorksheet).Reset
End Sub
Sub SysInit()
    Dim CmbMenu As Variant
    If (g_nCommand = 1) Then    '定义报表
        For Each CmbMenu In Application.MenuBars(xlWorksheet).Menus
            CmbMenu.Delete
        Next
        With Application.MenuBars(xlWorksheet).Menus
            .Add "文件"
            With .Item("文件").MenuItems
                .Add "退出"
                .Item("退出").OnAction = "ButtonAction.AppQuit"
            End With
            .Add "数据定义"
            With .Item("数据定义").MenuItems
                .Add "采集量定义"
                .Item("采集量定义").OnAction = "ButtonAction.DefineScadaDlg"
                .Add "整列设置"
                .Item("整列设置").OnAction = "ButtonAction.DefineStatColDlg"
                '.Add "统计量定义"
               ' .Item("统计量定义").OnAction = "ButtonAction.DefineStatDlg"
                '.Add "时间定义"
                '.Item("时间定义").OnAction = "ButtonAction.DefineTimeDlg"
                .Add ("删除数据定义")
                .Item("删除数据定义").OnAction = "ButtonAction.DeleteCellDefine"
            End With
            .Add "编辑"
            With .Item("编辑").MenuItems
                .Add "复制"
                .Item("复制").OnAction = "ButtonAction.Copy"
                .Add "粘贴"
                .Item("粘贴").OnAction = "ButtonAction.Paste"
                .Add "整列粘贴"
                .Item("整列粘贴").OnAction = "ButtonAction.PasteCol"
                .Add "刷新"
                .Item("刷新").OnAction = "ButtonAction.ShowDefine(True)"
                .Add "插入一空行"
                .Item("插入一空行").OnAction = "ButtonAction.InsertRow"
                .Add "插入一空列"
                .Item("插入一空列").OnAction = "ButtonAction.InsertCol"
                .Add "删除一行"
                .Item("删除一行").OnAction = "ButtonAction.DeleteRow"
                .Add "删除一列"
                .Item("删除一列").OnAction = "ButtonAction.DeleteCol"
          End With
            .Add "系统切换"
            With .Item("系统切换").MenuItems
                .Add "恢复Excel菜单"
                .Item("恢复Excel菜单").OnAction = "ButtonAction.ExcelMenu"
            End With
        End With
    ElseIf (g_nCommand = 2) Then    '生成报表
        For Each CmbMenu In Application.MenuBars(xlWorksheet).Menus
            CmbMenu.Delete
        Next
        With Application.MenuBars(xlWorksheet).Menus
            .Add "文件"
            With .Item("文件").MenuItems
                .Add "发布报表"
                .Item("发布报表").OnAction = "ButtonAction.SaveAsHTML"
                .Add "退出"
                .Item("退出").OnAction = "ButtonAction.AppQuit"
            End With
            .Add "系统切换"
            With .Item("系统切换").MenuItems
                .Add "恢复Excel菜单"
                .Item("恢复Excel菜单").OnAction = "ButtonAction.ExcelMenu"
            End With
        End With
    End If
End Sub


然后点调试，就在停在红色文字部分，求助大神帮忙啊！！

小和尚的烂人参

自己顶起！！

wdfang

看一看 CRepDlg设置是否对

ning84

Private Sub del()
    Dim xlsShp As Shape
    Dim xlsChart As Chart
    Dim Sht As Worksheet
    Dim oChart As ChartObject
         Set Sht = Sheet2
               For Each oChart In Sht.ChartObjects
                    Debug.Print oChart.Name
                    oChart.Select
                    ActiveWindow.SelectedSheets.Delete
               Next oChart
         Set xlsShp = Sht.Shapes.AddChart
         Set xlsChart = xlsShp.Chart
         With xlsChart
                '.Location xlLocationAsNewSheet
                .SetSourceData Source:=Workbooks("中国东西南北城市.xls").Sheets("Tmp").Range("B2:I5")
                .Location xlLocationAsNewSheet
               
         End With
   
End Sub