AW: schneller
03.12.2021 17:22:28
Ulli
Hallo Uwe,
danke für deine Mühe.
Der Code läuft durch aber die ausgeblendeten Zeilen werden nicht gelöscht. (Bei beiden Varianten)
Ich starte den Code aus einer Makrodatei, diese wird dann als xlsx abgespeichert (mit den gelöschten Objekten, Zeilen etc..)und die Makrodatei wird wieder geöffnet.
Hier der komplette Code mit deiner Ergänzung:
Sub Konvertieren()
' Konvertieren Makro
' Löschen Makro
' löschen Command Button, Checkboxen, Kommentare, schaltflächen
'ActiveSheet.Shapes.SelectAll
'Selection.Delete
Call Drucken
Call Drucken1
Dim CB, I, nam, strWs(), Antwort, wbPDF As Workbook
Dim oShp As Shape
Dim sh As Shape
Dim j As Long
Dim ws As Worksheet
Dim wks As Worksheet
Dim cmnt As Comment
Dim xOLE As Object
Dim Wkz As Worksheet, LR As Long
nam = ThisWorkbook.Name: nam = Split(nam, "."): nam = ActiveWorkbook.Path & "\" & nam(0)
For Each CB In ActiveSheet.OLEObjects
If Left(CB.Name, 8) = "CheckBox" Then
If CB.Object.Value = True Then
I = I + 1
ReDim Preserve strWs(1 To I)
strWs(I) = CB.Object.Caption
End If
End If
Next CB
ThisWorkbook.Sheets(strWs).Select
Sheets(strWs).Copy
nam = nam & "-1"
Set wbPDF = ActiveWorkbook
Application.DisplayAlerts = False
With wbPDF
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nam, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
.BreakLink Name:=ThisWorkbook.FullName, Type:=xlExcelLinks
For Each wks In ActiveWorkbook.Sheets ' alle Kommentare löschen
For Each cmnt In wks.Comments
cmnt.Delete
Next cmnt
Next
For Each oShp In ActiveSheet.Shapes ' Command Button löschen
If UCase(Left(oShp.Name, 13)) = "COMMANDBUTTON" Then
oShp.Delete
End If
Next
For Each sh In ActiveSheet.Shapes ' Checkboxen löschen
If sh.Type = msoOLEControlObject Then
If TypeOf sh.OLEFormat.Object.Object Is msforms.CheckBox Then
sh.Delete
End If
End If
Next
On Error Resume Next 'alle Schaltflächen löschen
For Each ws In Worksheets
ws.Buttons.Delete
For Each xOLE In ws.OLEObjects
If TypeName(xOLE.Object) = "CommandButton" Then
xOLE.Delete
End If
Next
Application.ScreenUpdating = False
For Each wks In ActiveWorkbook.Sheets
For Each cmnt In wks.Comments ' alle Kommentare löschen
cmnt.Delete
Next cmnt
For Each oShp In wks.Shapes ' Command Button löschen
If UCase(Left(oShp.Name, 13)) = "COMMANDBUTTON" Then
oShp.Delete
End If
Next
Select Case Wkz.Name ' ausgeblendete Zeilen löschen
Case "Muster1", "Muster2"
LR = Wkz.UsedRange.SpecialCells(xlCellTypeLastCell).Row
If LR > 1 Then
For I = LR To 1 Step -1
If Wkz.Rows(I).Hidden Then
Wkz.Rows(I).Delete
End If
Next
End If
End Select
Next
Application.ScreenUpdating = True
Next
.SaveAs Filename:=nam, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
.Close SaveChanges:=False
End With
Application.DisplayAlerts = True
Sheets(1).Select
End Sub