Excel VBA运行，但分配宏时不运行

Question

I have some VBA code that I run in the VBA area with the green play button to "Run Sub/UserForm" and it runs great. However, I create a Shape and then assign a macro to it so a user can just click the shape, but it does not work. It says "Cannot run the macro ''IMD Automation.xlsm'!IMDAutomation'. The macro may not be available in this workbook or all macros may be disabled."

I've looked around and I enabled all content. I created a new workbook and copied all the code over, but nothing.

Full Code below

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

Any guidance would be appreciated.

Answer 1

Try to add "Public" on your "Sub" and activate your Workbook:

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

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