mit dem folgenden Makro Speichere ich meine Arbeit in einem anderen Ordner.
Damit werden die "Tabelle1", das "Deckblatt" sowie "Bearbeiten" gespeichert.
Nun wird aber aus dem "Deckblatt" ein Code, der im Tabellenblatt steht, mit kopiert.
Dieser Code wird jedoch im gespeicherten Neuen Ordner nicht mehr benötigt, und er verursacht hier Fehler.
Ist es möglich, beim Speichern des TBL.Blatt "Deckblatt" im Neuen Ordner diesen Code oben zu Löschen?
Fehler ist- es gibt das Worksheets("Hilfstabelle EINGABE") im Neuen Ordner nicht.
Was könnte ich tun?
Der Code lautet:
Option Explicit
Private Sub Worksheet_Activate()
Dim objShap As Shape
Dim blnFound As Boolean
With Worksheets("Deckblatt")
For Each objShap In .Shapes
If Not Intersect(objShap.TopLeftCell, .Range("A43:M50")) Is Nothing Or _
Not Intersect(objShap.BottomRightCell, .Range("A43:M50")) Is Nothing Then
blnFound = True
Set objShap = Nothing
Exit For
End If
Next
End With
Worksheets("Hilfstabelle EINGABE").[Z6].Interior.Color = IIf(blnFound, vbWhite, vbGreen)
Worksheets("Hilfstabelle EINGABE").[Z7].Interior.Color = IIf(blnFound, vbGreen, vbWhite)
End Sub
Ist es möglich, beim Speichern des TBL.Blatt "Deckblatt" im Neuen Ordner diesen Code oben zu Löschen?
Public Sub Speichern_in_PDF_XLSX()
Dim varPath As Variant
Dim strDir As String
Dim wkb As Workbook, wkbCopy As Workbook, bolSpeichern As Boolean
On Error GoTo Fin
Sheets("Tabelle1").Select
varPath = Application.GetSaveAsFilename( _
InitialFileName:="D:\Desktop\PDF_Brennordner", _
FileFilter:="Excel(*.xlsx), *.xlsx", _
Title:="Save as XLSX and PDF")
If Not varPath = False Then
strDir = Left(varPath, InStrRev(varPath, "\"))
Set wkb = ActiveWorkbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
If Dir(varPath) "" Then
Select Case MsgBox("Datei überschreiben?", 4 + 32 + 0, "Datei")
Case vbYes
bolSpeichern = True
Case Else
GoTo Fin
End Select
Else
bolSpeichern = True
End If
Windows("Vorlage.xlsm").Activate
Sheets("Tabelle1").Select
Range("B20").Select
''''ActiveCell.FormulaR1C1 = " "
Range("N19").Select
If bolSpeichern = True Then
wkb.Sheets("Tabelle1").Copy
Set wkbCopy = ActiveWorkbook
With wkbCopy
wkb.Sheets("Deckblatt").Copy After:=.Sheets(1)
wkb.Sheets("Bearbeiten").Copy After:=.Sheets(2)
.SaveAs varPath, 51
.Close False
End With
Set wkbCopy = Nothing
With wkb
.Worksheets("Tabelle1").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDir & "Tabelle1 " & Format(Date, "YYYY-MM") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Worksheets("Deckblatt").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDir & "Deckblatt " & Format(Date, "YYYY-MM") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
End With
Set wkb = Nothing
End If
Else
MsgBox "Abgebrochen..."
End If
Fin:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description
On Error Resume Next
With Sheets("Deckblatt") 'grün
.Tab.Color = _
RGB(0, 255, 0)
.Tab.TintAndShade = 0
End With
On Error Resume Next
With Sheets("Tabelle1") 'grün
.Tab.Color = _
RGB(0, 255, 0)
.Tab.TintAndShade = 0
End With
On Error Resume Next
With Sheets("Bearbeiten") 'grün
.Tab.Color = _
RGB(0, 255, 0)
.Tab.TintAndShade = 0
End With
On Error Resume Next
With Sheets("Bestand_Bearb.") 'grün
.Tab.Color = _
RGB(0, 255, 0)
.Tab.TintAndShade = 0
End With
End Sub
Gruß Andreas