Question

我有以下逻辑从excel通过outlook发送电子邮件。使用用户表单。问题是选中复选框后激活文本框。 texbox在检查时不会激活。我也试过了可见属性。

问题是复选框没有激活else语句的逻辑。

Private Sub CommandButton9_Click()
On Error GoTo ERRORMSG
Dim OutApp As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object


Set otlApp = CreateObject("Outlook.Application")
Set olMail = otlApp.CreateItem(olMailItem)
Set Doc = olMail.GetInspector.WordEditor
Set mainWB = ActiveWorkbook

If CheckBox1.Value = False Then

mainWB.Sheets("Mail").Range("m8").Value = ComboBox4.Value
mainWB.Sheets("Mail").Range("n8").Value = TextBox40.Value
mainWB.Sheets("Mail").Range("q8").Value = ComboBox5.Value
mainWB.Sheets("Mail").Range("r8").Value = ComboBox6.Value
mainWB.Sheets("Mail").Range("s8").Value = ComboBox7.Value
mainWB.Sheets("Mail").Range("t8").Value = TextBox44.Value


 On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0

Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = "mainWB.Sheets("Mail").Range("G12").Value"
    .cc = mainWB.Sheets("Mail").Range("L12").Value
    .Subject = mainWB.Sheets("Mail").Range("O15").Value
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    Set oRng = wdDoc.Range

    'force html format
    .HTMLBody = "<HTML><body><body></HTML>"
    .display


    '--- start with 6 CrLf's, so we can place each table
    '    above all but the last used...
    oRng.InsertAfter vbCrLf & vbCrLf

    '--- now reselect the entire document, collapse our cursor to the end
    '    and back up one character (so that the table inserts before the SIXTH CrLf)
    Set oRng = wdDoc.Range
    oRng.collapse 0
    oRng.Move 1, -1
    Range("K3:T10").Select
    Selection.Copy
    oRng.Paste


    '--- finally move the cursor all the way to the end and paste the
    '    second table BELOW the SIXTH CrLf
    Set oRng = wdDoc.Range
    oRng.collapse 0
    Range("K38:T46").Select
    Selection.Copy
    oRng.Paste
End With

Else
Label54.enable = True
TextBox46.enable = True

mainWB.Sheets("Mail").Range("m57").Value = ComboBox4.Value
mainWB.Sheets("Mail").Range("n57").Value = TextBox40.Value
mainWB.Sheets("Mail").Range("O57").Value = TextBox46.Value
mainWB.Sheets("Mail").Range("q57").Value = ComboBox5.Value
mainWB.Sheets("Mail").Range("r57").Value = ComboBox6.Value
mainWB.Sheets("Mail").Range("s57").Value = ComboBox7.Value
mainWB.Sheets("Mail").Range("t57").Value = TextBox44.Value


 On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0

Set OutMail = OutApp.CreateItem(0)

With OutMail
    .To = "mainWB.Sheets("Mail").Range("G12").Value"
    .cc = mainWB.Sheets("Mail").Range("L12").Value
    .Subject = mainWB.Sheets("Mail").Range("O15").Value
    Set olInsp = .GetInspector
    Set wdDoc = olInsp.WordEditor
    Set oRng = wdDoc.Range

    'force html format
    .HTMLBody = "<HTML><body><body></HTML>"
    .display


    '--- start with 6 CrLf's, so we can place each table
    '    above all but the last used...
    oRng.InsertAfter vbCrLf & vbCrLf

    '--- now reselect the entire document, collapse our cursor to the end
    '    and back up one character (so that the table inserts before the SIXTH CrLf)
    Set oRng = wdDoc.Range
    oRng.collapse 0
    oRng.Move 1, -1
    Range("K52:T59").Select
    Selection.Copy
    oRng.Paste


    '--- finally move the cursor all the way to the end and paste the
    '    second table BELOW the SIXTH CrLf
    Set oRng = wdDoc.Range
    oRng.collapse 0
    Range("K38:T46").Select
    Selection.Copy
    oRng.Paste
End With
End If
Exit Sub
ERRORMSG:
MsgBox "No email was sent", vbExclamation
End Sub

Answer 1

你必须：

在执行任何Userform事件处理代码之前设置Label54和TextBox46 Enabled属性

这可以实现：

使用Private Sub UserForm_Initialize() sub：

Private Sub UserForm_Initialize()
    With Me
        .Label54.Enabled = False
        .TextBox46.Enabled = False
    End With
End Sub

或在＆＃34; main＆＃34;的Userform调用块中子

Sub Main()

    ... code

    With MyUserForm '<--| change "MyUserForm" to your actual userform name
        .Label54.Enabled = False
        .TextBox46.Enabled = False

        ... other possible code here to set some Userform members before showing it

        .Show '<--| show your userform
    End With
    Unload MyUserForm

    ... more code

End SUb

将Label54事件处理程序中的TextBox46和Enabled CommandButton9_Click属性设置为CheckBox1值

如下：

Option Explicit

Private Sub CommandButton9_Click()
    Dim OutApp As Object
    Dim mailSht As Worksheet
    Dim rowOffset As Long

    Set OutApp = GetApp("Outlook.Application")
    If OutApp Is Nothing Then
        MsgBox "Couldn't set 'Outlook.Application' object"
        Exit Sub
    End If

    Set mailSht = ActiveWorkbook.Sheets("Mail")
    rowOffset = IIf(CheckBox1, 56, 7) '<--| set a row offset (from row 1) in according to CheckBox value

    Label54.Enabled = CheckBox1 '<--| enable Label54 control if CheckBox1 is checked
    TextBox46.Enabled = CheckBox1 '<--| enable TextBox46 control if CheckBox1 is checked

    With Me '<--| refer to this userform
        'fill "Mail" sheet properly offsetted cells with ComboBoxes and TextBoxes values
        FillRangeWithComboBoxValue .ComboBox4, mailSht.Range("m1").Offset(rowOffset)
        mailSht.Range("n1").Offset(rowOffset).value = .TextBox40.value
        FillRangeWithComboBoxValue .ComboBox5, mailSht.Range("q1").Offset(rowOffset)
        FillRangeWithComboBoxValue .ComboBox6, mailSht.Range("r1").Offset(rowOffset)
        FillRangeWithComboBoxValue .ComboBox7, mailSht.Range("s1").Offset(rowOffset)
        mailSht.Range("t1").Offset(rowOffset).value = .TextBox44.value
    End With

    On Error GoTo ERRORMSG
    With OutApp.CreateItem(0)
        .To = mailSht.Range("G12").value
        .CC = mailSht.Range("L12").value
        .Subject = mailSht.Range("O15").value

        'force html format
        .HTMLBody = "<HTML><body><body></HTML>"
        .display
        With .GetInspector.WordEditor
            '--- start with 6 CrLf's, so we can place each table
            '    above all but the last used...
            .Range.InsertAfter vbCrLf & vbCrLf

            '--- now reselect the entire document, collapse our cursor to the end
            '    and back up one character (so that the table inserts before the SIXTH CrLf)
            With .Range
                .collapse 0
                .Move 1, -1
                mailSht.Range("K3:T10").Copy
                .Paste
            End With

            '--- finally move the cursor all the way to the end and paste the
            '    second table BELOW the SIXTH CrLf
            With .Range
                .collapse 0
                mailSht.Range("K38:T46").Copy
                .Paste
            End With
        End With
    End With
    Set OutApp = Nothing '<--| dispose the object variable

    Exit Sub
ERRORMSG:
    MsgBox "Error on email processing", vbExclamation
End Sub

Function GetApp(appName As String) As Object
    On Error Resume Next
    Set GetApp = GetObject(, appName)
    If GetApp Is Nothing Then Set GetApp = CreateObject(appName)
End Function

Sub FillRangeWithComboBoxValue(cb As msforms.ComboBox, rng As Range)
    If cb.ListIndex <> -1 Then rng.value = cb.value
End Sub

你看到我提出了一些代码缩短和模块化提示，以便（希望）更具可读性和可维护性

Answer 2

谢谢大家，这是一个简单的修复。我将复选框条件放在复选框更改事件中，它就像一个gem。

Private Sub CheckBox1_Change()

excel在userform中发送电子邮件宏

2 个答案: