bei einfachem Klick auf eine E-Mail-Adresse in Spalte T wird in Outlook eine E-Mail generiert mit eingefügter Grafik.
Der Einfach-Klick hat sich als unpraktisch erwiesen, da ich immer wieder eine E-Mail-Adresse ändern muss, ohne dass sich jedes Mal ein Mailentwurf öffnet.
Wie ändere ich dieses Makro ab auf Doppelklick-Event?
Danke schön für eure Hilfe
Margarete
Option Explicit
Sub MailLine(r&)
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim t As ListObject, B As Range, Dia As ChartObject, Pfad$, Datei$
Dim Ol As Object, OlCreate As Boolean, dName$, i&
Application.ScreenUpdating = False
Pfad = Wb.Path & "\"
dName = "RngCache.jpg"
Set t = Ws.ListObjects(1)
With t.DataBodyRange
For i = 1 To .Rows.Count
If i r Then .Rows(i).EntireRow.Hidden = True
Next i
End With
With Ws
.Range("D:F,H:N").EntireColumn.Hidden = True
Set B = t.Range.Resize(, 19)
B.CopyPicture
Set Dia = .ChartObjects.Add(B.Left, B.Top, B.Width, B.Height)
With Dia
.Activate
.Chart.Paste
.Chart.Export Pfad & dName, "jpg" '*********** jpg wird generiert und _
wieder gelöscht********
.Delete
End With
End With
t.DataBodyRange.Rows.EntireRow.Hidden = False
On Error Resume Next
Set Ol = GetObject(, "Outlook.Application")
If Err Then
Set Ol = CreateObject("Outlook.Application"): OlCreate = True
End If
Ol.Visible = True
With Ol.createitem(0)
.Subject = "Ihre Restlaufschätzung"
.To = t.DataBodyRange.Cells(r, 11).Text '**************anpassen******** _
.htmlbody = "" _
& "" _
& "Hallo," & "
" & "als Unterstützung für Sie als Phasenverantwortlichem _
hier eine automatisierte Erinnerung, welche Schätzung(en) überfällig ist/sind:" & "
" & "
"
.attachments.Add Pfad & dName, 1, 0
.htmlbody = .htmlbody & "
" & " Bitte denken Sie auch an das Abhaken von erfolgten ÜGG - _
Anleitung anbei. Ohne gesetzten Haken können Sie keine RLS durchführen. " & "" _
& "
" & " Beste Grüße aus der APAL" & "
"
.attachments.Add "X:\COP-Ergebnisse\Full Set\Einführung Full Set\Abhaken ÜGG bei _
Phasenstart.pdf"
.display 'alternativ: .Send
End With
Kill Pfad & dName
If OlCreate Then Ol.Quit: Set Ol = Nothing
Application.ScreenUpdating = True
End Sub