Question

我在VBA区域中运行了一些VBA代码，并使用绿色的播放按钮“ Run Sub / UserForm”运行，效果很好。但是，我创建了一个Shape，然后为其分配了一个宏，以便用户可以单击该Shape，但是它不起作用。它说：“无法运行宏'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

任何指导将不胜感激。

Answer 1

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

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

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

Excel VBA运行，但分配宏后不会运行

1 个答案: