excel отправить почтовый макрос в пользовательской форме

У меня есть следующая логика для отправки электронной почты через Outlook от Excel. используя пользовательскую форму. Проблема заключается в том, что текстовое поле активируется при выборе флажка. Тексбокс не активируется при его проверке. Я также попытался с видимым свойством.excel отправить почтовый макрос в пользовательской форме

Проблема заключается в том, что флажок не активирует логику, указанную в инструкции 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

источник

2016-08-31 Coding Enthusiast

Что вы имеете в виду текстовое поле не активным после проверки его? Вы хотите установить фокус на текстовое поле? – gizlmo

'Label54.enable = True TextBox46.enable = True' изначально настроен на включение false. Затем я применил логику с помощью флажка, чтобы активировать метку и texbox при проверке флажка, но ничего не делает. Я ни на что не фокусировался. Я не хочу сосредоточиться на чем-либо. –

Хорошо, правильная настройка - 'TextBox46.Enabled = True' вместо' TextBox46.Enable = True' – gizlmo

вы должны:

набор как Label54 и TextBox46Enabled свойство перед выполнением каких-либо событие UserForm код обработки

этого можно достичь:

либо с a Private Sub UserForm_Initialize() суб:

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

или в вызывающем блоке 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 и TextBox46Enabled свойство в обработчике событий 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

где вы видите, что я предложил некоторый код укорочение и modulizing советов, чтобы иметь его (надеюсь) более читаемый и ремонтопригоден

источник

2016-08-31 08:24:24 user3598756

Появится ли показатель _brave_ downvoter и даст какое-либо объяснение, чтобы оба знали, почему они не должны следовать этому ответу и научить меня, как его улучшить? – user3598756

Спасибо Ребят, это было легко исправить. Я помещаю условие флажка в событие изменения флажка, и он работает как драгоценный камень.

Private Sub CheckBox1_Change()

источник

2016-08-31 09:20:02

Изобразительное. Однако вы можете рассмотреть рефакторинг кода, который я вам предложил – user3598756

Спасибо, тонна, я буду изучать это. Модулирование кода удивительно. Но это займет некоторое время, поскольку у меня есть несколько кодов в пользовательской форме. –

, то вы можете опубликовать его в [Обзор кода] (http: //codereview.stackexchange.com/questions/tagged/vba), и люди помогут вам повысить качество кода и (возможно) производительность – user3598756

excel отправить почтовый макрос в пользовательской форме

ответ

Смежные вопросы