Re: Symbole in Userform
22.01.2003 01:59:57
L.Vira
Nein, eben das geht nur in Symbolleisten. Hiermit kannst du dir
die Symbole in eine Tabelle kopieren und auch wieder löschen.
Der Rest dann so, wie beschrieben:Option Explicit
Sub Symbole()
Dim von As Integer
Dim bis As Integer
Dim cBar As CommandBar
Dim cbb As CommandBarButton
Dim k As Integer
Dim B As Single, I As Integer, J As Integer
Dim T As Single
von = 1
On Error GoTo ende
bis = InputBox("L.Vira...", "wieviele?", "100")
If Not IsNumeric(bis) Then Exit Sub
Application.ScreenUpdating = False
Cells.RowHeight = 16
Cells.ColumnWidth = 2.6
Set cBar = CommandBars.Add
cBar.Visible = False
I = 1
For k = 1 To bis / 15
For J = 1 To 30 Step 2
Cells(k, J) = I
I = I + 1
Next
Next
J = 2
I = 1
B = (Cells(I, J).Width - 12) / 2
T = 4.5
Set cbb = cBar.Controls.Add(Type:=msoControlButton)
For k = von To bis
Err.Clear
On Error Resume Next
cbb.FaceId = k
If Err.Number = 0 Then
cbb.CopyFace
ActiveSheet.Cells(I, J).PasteSpecial
With Selection.ShapeRange
.Left = .Left + B
.Top = T
End With
End If
If J = 30 Then
J = 0
I = I + 1
T = T + 15
End If
J = J + 2
Next
cBar.Delete
[a1].Select
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