Problem Userform
07.10.2019 10:50:16
Thomas
Ich starte Excel und Userform1 wird angezeigt, alles funktioniert. Über einen Button wechsel ich in die Userform2, und blende Userform1 mit Userform1.hide aus.
Wenn ich erst in Userform1 das Makro "email_with_range_UF1" ausführe und im Anschluss in der Userform2 "Dispo_Mail_UF2" klappt alles.
Wenn ich aber umgedreht mache, also erst Userform2, Makro "Dispo_email_UF2" und dann in die Userform1 wechsel und "email_with_range_UF1" ausführen will, wird zwar der richtige Email Verteiler angesprochen, aber das Bild von "Dispo_email_UF2" eingefügt.
Was mache bzw. wo liegt der Fehler?
Hier die beiden Makros
Sub email_with_range_UF1()
Application.ActiveWorkbook.RefreshAll
Dim TempFilePath As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim xHTMLBody As String
Dim xRg As Range
On Error Resume Next
Set xRg = Worksheets("Drucken").Range("A1:AJ57")
If xRg Is Nothing Then Exit Sub
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set xOutApp = CreateObject("outlook.application")
Set xOutMail = xOutApp.CreateItem(olMailItem)
Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
TempFilePath = Environ$("temp") & "\"
xHTMLBody = "
" _
& "
" _
With xOutMail
.Subject = "" & "" & ThisWorkbook.Worksheets("Drucken").Range("BJ12")
.HTMLBody = xHTMLBody
.Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
.To = "Test@Test.de"
.GetInspector
.Display
'.Send
End With
Application.DisplayAlerts = False
ThisWorkbook.Saved = True
'Call Drucken_Konzern
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
Dim xRgPic As Range
ThisWorkbook.Activate
Worksheets("Drucken").Activate
Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
xRgPic.CopyPicture
With ThisWorkbook.Worksheets("Drucken").ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic. _
Width, xRgPic.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
End With
Worksheets("Drucken").ChartObjects(Worksheets("Drucken").ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub
Sub mail_Dispo_UF2()
Application.ActiveWorkbook.RefreshAll
Dim TempFilePath As String
Dim xOutApp As Object
Dim xOutMail As Object
Dim xHTMLBody As String
Dim xRg As Range
On Error Resume Next
Set xRg = Worksheets("Zeitplan").Range("A1:AJ27")
If xRg Is Nothing Then Exit Sub
With Application
.Calculation = xlManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set xOutApp = CreateObject("outlook.application")
Set xOutMail = xOutApp.CreateItem(olMailItem)
Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
TempFilePath = Environ$("temp") & "\"
xHTMLBody = "
" _
& "
" _
With xOutMail
.Subject = "" & "" & ThisWorkbook.Worksheets("Zeitplan").Range("R2")
.HTMLBody = xHTMLBody
.Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
.To = "Dipso.Test@Test.de"
.GetInspector
.Display
'.Send
End With
Application.DisplayAlerts = False
ThisWorkbook.Saved = True
'Call Drucken_Zeitplan
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
Dim xRgPic As Range
ThisWorkbook.Activate
Worksheets("Zeitplan").Activate
Set xRgPic = ThisWorkbook.Worksheets("Zeitplan").Range(xRgAddrss)
xRgPic.CopyPicture
With ThisWorkbook.Worksheets("Zeitplan").ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic. _
Width, xRgPic.Height)
.Activate
.Chart.Paste
.Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
End With
Worksheets("Zeitplan").ChartObjects(Worksheets("Zeitplan").ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub