Fatal编程技术网
  • vba/
  • Vba excel中定义的宏位置

Vba excel中定义的宏位置

vba excel macros

Vba excel中定义的宏位置,vba,excel,macros,location,Vba,Excel,Macros,Location,我有一本120多页的工作簿，它的首页有一个很好的功能，可以提取指定的工作表，并将其保存为一本包含大量细节的新书。这一切都很好。但正在尝试添加新函数。在提取的工作表上，我添加了一个按钮并创建了一个宏，该宏将通过电子邮件发送完成的文章。问题是，宏的位置引用会保持默认值，返回到原始图书源，而不是图纸本身（其所有.XLSM文件）。宏本身在每个工作表上，但我找不到一种方法将宏的引用固定到工作表上。我的谷歌fu让我失望了。任何有智慧的意见或话语都将不胜感激 好的，这是mailer宏： Sub Mail_Fi

我有一本120多页的工作簿，它的首页有一个很好的功能，可以提取指定的工作表，并将其保存为一本包含大量细节的新书。这一切都很好。但正在尝试添加新函数。在提取的工作表上，我添加了一个按钮并创建了一个宏，该宏将通过电子邮件发送完成的文章。问题是，宏的位置引用会保持默认值，返回到原始图书源，而不是图纸本身（其所有.XLSM文件）。宏本身在每个工作表上，但我找不到一种方法将宏的引用固定到工作表上。我的谷歌fu让我失望了。任何有智慧的意见或话语都将不胜感激

好的，这是mailer宏：

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
使用ActiveX按钮

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

Mail\u FinishedSheet\u Array（）
Sub如果要使其独立于“Checkbook.xlsm”，则必须也位于新工作簿中。在这种情况下，Sub必须位于新工作簿中复制的两个工作表（
Sheet1.CmbSheet.Value
或“Z-MISC”）中的一个（
user3598756）中。使用ActiveX按钮，然后直接将宏分配给它（右键单击，查看代码），效果非常好。
ah。。。除非有一些代码。有时它们是有用的。邮件程序的宏相当常见，而且它在物理上可以工作（如果我不提取其中一个工作表并运行它，它会执行它应该执行的所有操作）只要提取工作表，按钮指向的位置就变成了“Checkbook.xlsm”！activesheet.mailsheet-这就是它崩溃的时候。我需要那个引用作为本地表单。我同意@cyboashu，如果你包含部分代码，那么它将更容易找到这个问题的根源。现场-非常感谢！

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