excel 中定义的宏位置

Question

我有一本120+sheet的工作簿，首页有一个很好的功能，可以提取指定的sheet，保存为一本新书，里面有一堆细节。一切正常。虽然试图添加一个新功能。在提取的 sheet 上，我添加了一个按钮并创建了一个宏，用于通过电子邮件发送完成的文章。问题是，宏的位置引用一直默认为原始书籍来源，而不是 sheet 本身（它的所有 .XLSM 文件）。宏本身在每个 sheet 上，但我找不到将宏的引用固定到 sheet 的方法。我的 google-fu 让我失望了。任何意见或智慧的话将不胜感激！

好的，这是邮件程序宏：

Sub Mail_FinishedSheet_Array()

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim SigString As String
    Dim Signature As String
    Dim StrBody As String

    Set wb1 = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
            Exit Sub
        End If
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Signature details with path
    SigString = Environ("appdata") & _
            "\Microsoft\Signatures\Zonal2014HO.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb1.Name & " " & Format(Now, "dd-mmm-yy hh-mm")
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                   Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    'Body contents for HTML format e-mail
    StrBody = "<BODY style=font-size:11pt;font-family:Calibri>Hi," _
    & "<p>Please find a completed checksheet attached for a PC Rebuild." _
    & "<p>Regards, " _
    & "<p></BODY>"

   ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .To = "Eng_Tech_support@zonal.co.uk"
        .CC = "rob.brown@zonal.co.uk"
        .BCC = ""
        .Subject = "Completed PC Rebuild Checksheet " & Format(Now, "dd-mmm-yy")
        .HTMLbody = StrBody & Signature
        .Attachments.Add wb2.FullName
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        .Display
    End With
    On Error GoTo 0

    wb2.Close SaveChanges:=False

    ' Delete the file.
    ' Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

这是主页上的提取宏，它从书中分离出欲望 sheet 并将其另存为新文件：

Sub Full_Extract()

Dim wbkOriginal As Workbook
Set wbkOriginal = ActiveWorkbook

'sets site and engineer details into the estate page that is being extracted
Worksheets(Sheet1.CmbSheet.Value).Range("B3").Value = Worksheets("front page").Range("E6")
Worksheets(Sheet1.CmbSheet.Value).Range("D3").Value = Worksheets("front page").Range("N6")
Worksheets(Sheet1.CmbSheet.Value).Range("F3").Value = Worksheets("front page").Range("K6")
Worksheets(Sheet1.CmbSheet.Value).Range("B4").Value = Worksheets("front page").Range("F8")
Worksheets(Sheet1.CmbSheet.Value).Range("D4").Value = Worksheets("front page").Range("K8")

' copies sheet name from combo box into new document, saves it with site name and current date
' into C:\Temp\ folder for ease of access

    With ActiveWorkbook.Sheets(Array((Sheet1.CmbSheet.Value), "Z-MISC"))
            .Copy
            ActiveWorkbook.SaveAs _
            "C:\temp\" _
            & ActiveWorkbook.Sheets(Sheet1.CmbSheet.Value).Cells(3, 2).Text _
            & " " _
            & Format(Now(), "DD-MM-YY") _
            & ".xlsm", _
            xlOpenXMLWorkbookMacroEnabled, , , , False
        End With

'code to close the original workbook to prevent accidental changes etc
Application.DisplayAlerts = False
wbkOriginal.Close
Application.DisplayAlerts = True
End Sub

Answer 1

使用 ActiveX 按钮

这要求其关联代码位于其所在的工作表中，之后 .Copy 和 ActiveWorkbook.SaveAs ... 语句将指向新创建的工作簿中的工作表

Mail_FinishedSheet_Array() 如果要使其独立于 "Checkbook.xlsm"，Sub 也必须在新工作簿中。在这种情况下，Sub 必须位于正在复制到新工作簿中的两个工作表（Sheet1.CmbSheet.Value 或 "Z-MISC"）之一中

Answer 2

user3598756 搞定了。使用 ActiveX 按钮然后直接将宏分配给它（右键单击，查看代码）效果很好。

excel 中定义的宏位置

defined macro locations in excel

macros

excel

vba

location