Kopie ohne Makro speichern
03.01.2013 19:26:10
Heinz
Im unteren Code versende ich eine Kopie per mail.
Nun kommt immer die Meldung "Ohne Makro versenden"
Ich möchte die Kopie immer ohne Makro,also als "xlsx" versenden.
Es liegt glaube ich in der Zeile
.SaveAs AWS
Könnte mir dazu bitte jemand helfen?
Gruß Heinz
Option Explicit
Sub Heinz1_Click()
Application.ScreenUpdating = False
Dim Nachricht As Object, OutApp As Object
Dim AWS As String, wksMail As Worksheet
Set OutApp = CreateObject("Outlook.Application")
Set wksMail = Sheets("Personalbesetzung") 'zu versendendes Blatt
AWS = Environ("USERPROFILE") & "\" & wksMail.Name & ".xlsx"
'temporäre Mappe erstellen
wksMail.Copy
With ActiveSheet
'########### Neu
Call BlattSchutz_Aufheben
.Shapes("Mail1").Delete
.Shapes("Mail2").Delete
' Ausblenden Makro
Columns("W:AA").Hidden = True
Rows("40:99").Hidden = True
' ActiveSheet.Drwaingobjects.Delete
With .Range("W5:Z19,Z40,B51:B95,Y51:Z72")
.Interior.ColorIndex = xlNone
.ClearContents
With .Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
.Font.ColorIndex = 0
End With
With .Range("Y51:Z72")
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Borders.LineStyle = xlNone
End With
.Range("W5").Select
With .Parent
.SaveAs AWS
.Close
End With
End With
Application.Visible = True
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = Cells(5, 24) 'E-Mail Adresse
.Cc = Cells(5, 26) 'E-Mail Adresse
.Subject = "Personalbesetzung KE " & " " _
& "Schicht" & " " & Worksheets("Personalbesetzung").Cells(5, 21) _
& " " & Worksheets("Personalbesetzung").Cells(5, 17)
.Attachments.Add AWS
.Body = "Mit freundlichen Grüßen" & vbNewLine & " " & Worksheets("Personalbesetzung"). _
Cells(5, 11)
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
Kill AWS 'temporäre Mappe löschen
ActiveSheet.Unprotect Password:="vetro"
' Einblenden Makro
Columns("W:AA").Hidden = False
Rows("40:99").Hidden = False
ActiveSheet.Protect Password:="vetro"
Application.ScreenUpdating = True
End Sub
Anzeige