时间戳

首页 > 解决方案 > Excel VBA 运行，但在分配宏时不运行

excel - Excel VBA 运行，但在分配宏时不运行

问题描述

我有一些在 VBA 区域中运行的 VBA 代码，带有绿色播放按钮以“运行子/用户窗体”，它运行得很好。但是，我创建了一个形状，然后为其分配了一个宏，这样用户就可以单击该形状，但它不起作用。它说“无法运行宏 ''IMD Automation.xlsm'!IMDAutomation'。此工作簿中可能没有该宏，或者所有宏都可能被禁用。”

我环顾四周并启用了所有内容。我创建了一个新工作簿并复制了所有代码，但什么也没有。

完整代码如下

Option Explicit

Public Sub IMDAutomation()
ThisWorkbook.Activate


Dim fileName As String 'Filename string

Dim wb_macro As Workbook 'Macro workbook
Dim ws_macro_imd As Worksheet 'Macro worksheet
Dim ws_macro_raw As Worksheet 'Macro raw worksheet
Dim wb_new As Workbook
Dim ws_new As Worksheet


Dim wb_imd As Workbook 'IMD Workbook for processing
Dim ws_imd As Worksheet 'IMD Worksheet for processing

Dim objTable As ListObject 'Table of raw data
Dim objTable2 As ListObject

Dim tbl_raw As ListObject 'Raw table in macro workbook
Dim tbl_imd As ListObject 'IMD table in macro workbook

Dim newRow As Range

Dim vals As Variant 'Array to store values

Dim lrow As Long 'Variable used to determine number of rows in data table

Set wb_macro = ThisWorkbook
Set ws_macro_imd = wb_macro.Sheets("IMD")
Set ws_macro_raw = wb_macro.Sheets("Raw")


'============ Initialize macro workbook - clearing data ============'
'Clear the raw data in the macro workbook
Set tbl_raw = ws_macro_raw.ListObjects("tbl_raw")
    With tbl_raw.DataBodyRange
           If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        End If
    End With
tbl_raw.DataBodyRange.Rows(1).ClearContents


'Clear the IMD data in the macro workbook
Set tbl_imd = ws_macro_imd.ListObjects("tbl_imd")
'    With tbl_imd.DataBodyRange
'        If .Rows.Count > 1 Then
'            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete ' Removed .Rows.Count-1
'        End If
'    End With


With tbl_imd
    If Not .DataBodyRange Is Nothing Then
        .DataBodyRange.Delete
    End If
End With
'tbl_imd.DataBodyRange.Rows(1).ClearContents
'tbl_imd.ListRows.Add


'============ Locate Raw Data File ============'
'Open file dialog to locate the Workforce Review raw data workbook exported from system
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Select the IMD file"
    .Filters.Clear
    .Filters.Add "Custom Excel Files", "*.xlsx, *xls, *csv"
    .Show
    fileName = .SelectedItems.Item(1)
End With
If InStr(fileName, ".xlsx") = 0 Then
Exit Sub
End If
Workbooks.Open fileName
'Set the Workforce Review raw workbook
Set wb_imd = ActiveWorkbook
'Set the worksheet
Set ws_imd = wb_imd.ActiveSheet


lrow = ws_imd.Cells(ws_imd.Rows.Count, 2).End(xlUp).Row
ws_imd.Range("A1:CU" & lrow).Copy

'vals = ws_imd.Range("A2:CU" & lrow)

tbl_raw.Resize tbl_raw.Range.Resize(lrow - 1)

ws_macro_raw.Range("A1").PasteSpecial
'tbl_raw.DataBodyRange.Value = vals

Application.CutCopyMode = False
Application.CutCopyMode = True
wb_imd.Close

ws_macro_imd.Range("tbl_imd[ParNumber]").NumberFormat = "@"
ws_macro_imd.Range("tbl_imd[PersLine]").NumberFormat = "@"
ws_macro_imd.Range("tbl_imd[NTE Date]").NumberFormat = "yyyy-mm-dd"

Dim lc As Long, mc As Variant, x As Variant
With tbl_imd
        'clear target table
        On Error Resume Next
        .DataBodyRange.Clear
        .Resize .Range.Resize(tbl_raw.ListRows.Count + 1, .ListColumns.Count)
        On Error GoTo 0

        'loop through target header and collect columns from tbl_raw
        For lc = 1 To .ListColumns.Count
            Debug.Print .HeaderRowRange(lc)
            mc = Application.Match(.HeaderRowRange(lc), tbl_raw.HeaderRowRange, 0)
            If Not IsError(mc) Then
                x = tbl_raw.ListColumns(mc).DataBodyRange.Value
'                .ListColumns(lc).DataBodyRange.NumberFormat = "@"
                .ListColumns(lc).DataBodyRange = x
            End If
        Next lc

    End With


Set wb_new = Workbooks.Add
ActiveSheet.Name = "IMD Processed"
Set ws_new = ActiveSheet

tbl_imd.Range.Copy
ws_new.Range("A1").PasteSpecial xlPasteValues
Set objTable2 = ws_new.ListObjects.Add(xlSrcRange, Selection, xlYes)

Application.GetSaveAsFilename



End Sub

任何指导将不胜感激。

标签： excelvba

解决方案

尝试在您的“子”上添加“公共”并激活您的工作簿：

Public Sub Automation()
    'Add this command line to activate your Excel Workbook
    ThisWorkbook.Activate

    '==============================
    '====    Your code here    ====
    '==============================
End Sub

推荐阅读