Makro beschläuigen/Excel beschläunigen
26.06.2017 11:55:06
Martina
ich habe in einer Excel-Datei 3 ähnliche Makros, die alle sehr lange Laufzeiten haben.
Hat jemand eine Idee, wie ich das optimieren könnte?
Mein Makro:
Sub ProtokollErstellen()
Dim olddate As String
'Beschleunigen:
With Application
.ScreenUpdating = False 'Bildschirm anzeigen
.EnableEvents = False
.Calculation = xlCalculationManual 'Berechnung ausschalten
End With
Worksheets("Protokoll").Unprotect 'Passwort aufheben
Worksheets("Protokoll").Columns("L:AZ").Clear 'Zeilen löschen
Worksheets("Punkte").Select
olddate = InputBox("Bitte das Datum eingeben", "Anwesenheitsliste erstellen")
If StrPtr(olddate) = 0 Then
Exit Sub
Else
[A:AD].AutoFilter Field:=17, Criteria1:="=" & olddate 'Autofilter anwenden
ActiveSheet.Range("A3:AG" & ActiveSheet.UsedRange.Rows.Count). _
SpecialCells(xlCellTypeVisible).Copy 'Autofilterdaten kopieren
End If
'...und ab "L28" in Tabelle2 einfügen
Worksheets("Protokoll").Range("L28").PasteSpecial
Worksheets("Protokoll").Calculate
'Formatierung ändern
Worksheets("Protokoll").Select
Columns("L:AZ").Select
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
'Optimale Zeilenhöhe
Sheets("Protokoll").Rows("28:62").EntireRow.AutoFit
'AutoFilter löschen
Sheets("Punkte").Select
Dim intI As Integer
With Worksheets("Punkte")
For intI = 1 To 31 ' hier bitte die Anzahl der Spalten mit Filter eingeben
Selection.AutoFilter Field:=intI
Next
End With
Worksheets("Protokoll").Select
Range("A1").Select
'Abfrage PDF Erstellen
If MsgBox("PDF erstellen?", vbYesNo) = vbNo Then
Application.ScreenUpdating = True
Worksheets("Protokoll").Protect
Exit Sub
ElseIf vbYes Then
Rem Pfad und Name der PDF-Datei
NeuerName = Range("Y28")
pdfName = "X:\Betriebsrat\BR-Sitzungen\2017\03 Sitzungsprotokoll 2017" & "\" & " _
Betriebsratsprotokoll_" & Format(NeuerName, "yyyy-mm-dd") & ".pdf"
Rem PDF-Datei erstellen
Worksheets("Protokoll").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
With Application
'Rückgängig Beschleunigen:
With Application
.ScreenUpdating = True 'Bildschirm anzeigen
.EnableEvents = True
.Calculation = xlCalculationAutomatic 'Berechnung einschalten
End With
Worksheets("Protokoll").Protect 'Schutz setzen
End With
End Sub
Vielen Dank
Martina