Sub Symbole()
Dim cb As CommandBar, cbb As CommandBarButton, Z As Long, I As Long
Dim von As Integer, bis As Integer, S As Integer, B As Single, T As Single
On Error GoTo ENDE
von = InputBox("K.Rola wills wissen...", "wo beginnen?", "1")
If Not IsNumeric(bis) Then Exit Sub
bis = von + 99
On Error GoTo ENDE
bis = InputBox("K.Rola wills wissen...", "bis wohin?", bis)
If Not IsNumeric(bis) Then Exit Sub
If bis < von Then Exit Sub
Application.ScreenUpdating = False
Cells.RowHeight = 16
Cells.ColumnWidth = 2.6
Set cb = CommandBars.Add
cb.Visible = False
I = von
For Z = 1 To (bis - von) / 15
For S = 1 To 30 Step 2
Cells(Z, S) = I
I = I + 1
Next
Next
S = 2
I = 1
B = (Cells(I, S).Width - 12) / 2
T = 4.5
Set cbb = cb.Controls.Add(Type:=msoControlButton)
For Z = von To bis
Err.Clear
On Error Resume Next
cbb.FaceId = Z
If Err.Number = 0 Then
cbb.CopyFace
ActiveSheet.Cells(I, S).PasteSpecial
With Selection.ShapeRange
.Left = .Left + B
.Top = T
End With
End If
If S = 30 Then
S = 0
I = I + 1
T = T + 15
End If
S = S + 2
Next
cb.Delete
[a1].Select
If bis > 999 Then Cells.Columns.AutoFit
Application.ScreenUpdating = True
ENDE:
End Sub
Sub Löschen()
Dim Sh As Shape, c As Integer
Cells.ClearContents
For Each Sh In ActiveSheet.Shapes
If Sh.Type = 13 Then
Sh.Delete
End If
Next
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen