letzter Versuch ...
06.11.2018 05:27:29
Matthias
Hallo Frieder
Meine Datei ist die gleiche, wie Du sie auch zur Verfügung hast
Um das zu prüfen, müsste(n) ich/wir Deine Datei sehen.
Mein Code braucht bei mir weniger als 1 Sekunde:
Hab jetzt den Vorschlag von Daniel mit eingepflegt.
Minimal schneller als vorher, aber eben schneller(also besser)
statt:
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlEdgeBottom).Weight = xlThin
nur noch:
.BorderAround xlContinuous, xlThick 'Tipp von Daniel
Der ganze Code also:
Sub RahmenThick()
Dim MyRow&, MyCol&
Dim MyCalculation
With Application
MyCalculation = .Calculation
.Calculation = False
.ScreenUpdating = False
.EnableEvents = False
End With
With Worksheets("Jahreskalender")
.Range("A2:AV2").Borders.Weight = xlThick
For MyRow = 3 To 93 Step 3
For MyCol = 1 To 48 Step 4
With .Cells(MyRow, MyCol).Resize(3, 4)
.BorderAround xlContinuous, xlThick 'Tipp von Daniel
' .Borders(xlEdgeTop).Weight = xlThick
' .Borders(xlEdgeLeft).Weight = xlThick
' .Borders(xlEdgeRight).Weight = xlThick
' .Borders(xlEdgeBottom).Weight = xlThick
End With
Next
Next
End With
With Application
.Calculation = MyCalculation
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Wobei Du bei:
.BorderAround xlContinuous, xlThick
auch das xlContinuous weglassen könntest und hättest dann eine gestrichelte Umrahmung.
Desweiteren könntest Du genau dort die Rahmenfarbe mitgeben.
z.B:
.BorderAround xlContinuous, ColorIndex:=5, Weight:=xlThick
Ich würde es ja gerne an Deiner Orginaldatei testen.
Dazu musst Du die Datei aber hier hochladen.
wie bereits erwähnt: bei mir weniger als 1 Sekunde!
Gruß Matthias