Question

我有一个工作簿，可根据截止日期发送电子邮件提醒。我想更改它，以便在我单击按钮时运行宏而不是在打开时自动运行。

的ThisWorkbook：

Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Cells(1, 1).Value = "Feedback Report (FR) Log" Then CheckDates ws:=ws
Next ws
End Sub

模块1：

Option Explicit

Dim Bcell As Range
Dim iTo, iSubject, iBody As String
Dim ImportanceLevel As String

Public Sub CheckDates(ws As Worksheet)
For Each Bcell In Range("a4", Range("a" & Rows.Count).End(xlUp))

    ' if email column is not empty then command continues
    If Bcell.Offset(0, 15) <> Empty Then         

        ' mail will not be sent if current time is within 23.7 hours
        '  from time of mail last sent.
        If Now() - Bcell.Offset(0, 49) > 0.9875 Then

        If Bcell.Offset(0, 25) = Empty Then

        If DateDiff("d", Now(), Bcell.Offset(0, 13)) = 7 Then

        iTo = Bcell.Offset(0, 15)

        iSubject = Bcell & " Due"

        iBody = "<font face=""Calibri"" size=""3"">" & "Dear all,<br/><br/>" & _
        "<u>FR No. " & Bcell & "</u><br/><br/>" & "Please be reminded that " & Bcell & " will be due by <b><FONT COLOR=#ff0000>" & _
        Bcell.Offset(0, 13) & "</font></b>." & _
        " Kindly ensure that the FR is closed by the due date and provide the draft FR report with preliminary investigation (Section B & D filled) to Quality.<br/><br/>" _
        & "Thank you<br/><br/>" & "Best Regards,<br/>" & "Quality Department<br/><br/>" _
        & "company Pte Ltd.<br/>" & "</font>"

        SendEmail
        Bcell.Offset(0, 49) = Now()

        End If
        End If
        End If
    End If
            iTo = Empty
            iSubject = Empty
            iBody = Empty
    Next Bcell

End Sub



Private Sub SendEmail()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail
        .To = iTo
        .CC = "email@email.com"
        .BCC = ""
        .Subject = iSubject
        .HTMLBody = iBody
        .Importance = ImportanceLevel
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .send

    End With

    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Answer 1

根据您要用于运行宏的按钮类型，有两种方法可以实现此目的：

a）如果按钮是简单的Shape（插入＆gt;形状），则需要将Workbook_Open的内容移动到Module1中的新子（让我们调用它＆＃34;触发＆＃34; ）并右键单击形状＆gt;分配宏＆gt; ＆＃34;触发＆＃34;

Sub trigger()
        Dim ws As Worksheet
        For Each ws In ThisWorkbook.Worksheets
            If ws.Cells(1, 1).Value = "Feedback Report (FR) Log" Then CheckDates ws:=ws
            End If
        Next ws
End Sub

b）如果按钮不是形状而是表单按钮，则需要在设计视图上双击它并移动＆＃34;触发＆＃34;到它自己的点击子（CommandButton1_click（））。

c）最后，请记住删除Workbook_Open（）sub。

的内容

如何将Thisworkbook宏指定给Form控件

1 个答案: