ActiveSheet.Shapes.Delete
19.12.2011 10:34:28
Heinz H.
Hallo Leute,im Forum
Im unteren Code wird aus einem Sheet eine Temp.Datei erzeugt,und per Outlook 2010 versendet.
Es funktioniert BIS auf "ActiveSheet.Shapes("Mail1").Delete"
Es kommt die Fehlermeldung
"Der angegebene Wert ist außerhalb des zulässigen Bereichs"
Ich möchte die erstellte Temp.Datei ohne Shapes versenden.
Hätte dazu bitte jemand eine Hilfestellung?
Danke Heinz
Option Explicit
Sub Heinz1_Click()
Application.ScreenUpdating = False
Dim Nachricht As Object, OutApp As Object
Set OutApp = CreateObject("Outlook.Application")
Dim AWS As String, wksMail As Worksheet
Set wksMail = Sheets("Personalbesetzung") 'zu versendendes Blatt
AWS = Environ("USERPROFILE") & "\" & wksMail.Name & ".xls"
'temporäre Mappe erstellen
wksMail.Copy
With ActiveWorkbook
ActiveSheet.Shapes("Mail1").Delete
'########### Neu
Call BlattSchutz_Aufheben
ActiveSheet.Range("W5:Z19,Z40,B51:B95,Y51:Z72").Select
Selection.Interior.ColorIndex = xlNone
Selection.ClearContents
'ActiveSheet.Range("W5").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 0
ActiveWindow.SmallScroll Down:=42
ActiveSheet.Range("Y51:Z72").Select
Selection.Interior.ColorIndex = xlNone
Selection.Font.ColorIndex = 0
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
ActiveWindow.SmallScroll Down:=-93
ActiveSheet.Range("W5").Select
.SaveAs AWS
.Close
End With
Application.Visible = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = "heinzholzmann@gmx.at"
.Cc = "heinz_holzmann@aon.at"
.Subject = "Personalbesetzung KE " & " " & "Schicht" & " " & Worksheets(" _
Personalbesetzung").Cells(5, 21) & " " & Worksheets("Personalbesetzung").Cells(5, 17)
.Attachments.Add AWS
.Body = "Mit freundlichen Grüssen" & vbNewLine & " " & Worksheets("Personalbesetzung"). _
Cells(5, 11)
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
Kill AWS 'temporäre Mappe löschen
Application.ScreenUpdating = True
End Sub