| Automatisch
neue Symbolleiste mit Befehlen erstellen |
19.02.2000 |
Folgende Routine, als Add-In einsetzbar, erstellt eine neue
Symbolleiste,
falls diese noch nicht vorhanden ist.
Diese Symbolleiste wird mit 2 neuen Symbolen versehen,
die beide eine entsprechende Sub zugewiesen bekommen.
|
|
Es ist ein sofort einsetzbares Add-In,
welches Sonderzeichen einf�gt:
|
|
�
|
�
|
Schritt 1
�ffnen Sie eine neue leere Arbeitsmappe
Schritt 2
In "Tabelle1" f�gen Sie �ber die Zwischenablage
2 Symbole ein, die Sie zuvor in einer
Grafikbearbeitungssoftware
erstellt haben.
Ein Tipp dazu: Kopieren Sie sich zun�chst ein vorhandenes
Symbol
aus einer Symbolleiste in Excel, um die genaue Gr��e zu
kennen.
Benennen Sie diese Symbole mit "Symbol1" und
"Symbol2".
|
|
|
Schritt 3
Wechseln Sie nun in den Visual
Basic Editor (Alt+F11)
Unter "DieseArbeitsmappe" f�gen Sie im Codefenster
folgendes ein:
Const Symbolleistenname = "Sonderzeichen"
Const Caption_1 = "&Durchmesserzeichen"
Const Caption_2 = "&Toleranz"
Private Sub Workbook_Open()
�� On Error Resume Next
�� Dim CB As CommandBar
�� Dim CMB As CommandBarButton
�� Set CB = Application.CommandBars(Symbolleistenname)
��
'Symbolleiste ist nicht vorhanden
��
If Err.Number <> 0 Then
����� Application.CommandBars(Symbolleistenname).Delete
����� Set CB =
Application.CommandBars.Add(Name:= _
��������
Symbolleistenname, temporary:=False, Position:=msoBarTop)
����� Set CMB = CB.Controls.Add(Type:=msoControlButton)
�����
'1. Symbol
�����
With CMB
�������� .Caption = Caption_1
�������� .OnAction =
"Durchmesserzeichen"
���������
ThisWorkbook.Sheets("Tabelle1").Shapes _
�����������
("Symbol1").Copy
��������� Application.CommandBars(Symbolleistenname)._
����������
Controls(1).PasteFace
����� End With
�����
'2. Symbol
�����
Set CMB = CB.Controls.Add(Type:=msoControlButton)
����� With CMB
�������� .Caption = Caption_2
�������� .OnAction =
"PlusMinus"
��������
ThisWorkbook.Sheets("Tabelle1").Shapes("Symbol2").Copy
�������� Application.CommandBars(Symbolleistenname)._
����������
Controls(2).PasteFace
����� End With
���� CB.Visible = True
�� End If
End Sub
Schritt 4
F�gen Sie ein neues
Modul ein,
welches die Routinen beinhalten soll, die beim Klick auf die
jeweiligen Schaltfl�chen ausgef�hrt werden:
Sub Durchmesserzeichen()
��
'falls keine Datei ge�ffnet ist
��
If Workbooks.Count = 0 Then
����� MsgBox "Es ist keine Datei ge�ffnet !", vbCritical, "Hinweis"
����� Exit Sub
�� End If
��
'aktuellen Wert ermitteln
��
Merk = ActiveCell.Value
�� With ActiveCell
�����
'steht etwas darin ?
�����
If Len(Merk) > 0 Then
��������
'ist das 1. Zeichen kein Durchmesserzeichen,
�������� 'dann Durchmesserzeichen voran stellen
��������
If Asc(Mid(Merk, 1, 1)) <> 198 Then� .Value = "� " & Merk
����� Else
��������
'ansonsten nur Durchmesserzeichen
��������
.Value = "� "
����� End If
�����
'1. Zeichen auf Schriftart "Symbol" setzen
�����
.Characters(Start:=1, Length:=1).Font.Name = "Symbol"
�����
'restliche Zeichen mit Schriftart "Arial"
�����
.Characters(Start:=3, Length:=100).Font.Name = "Arial"
�� End With
End Sub
Sub PlusMinus()
��
'falls keine Datei ge�ffnet ist
��
If Workbooks.Count = 0 Then
����� MsgBox "Es ist keine Datei ge�ffnet !", vbCritical, "Hinweis"
����� Exit Sub
�� End If
��
'aktuellen Wert ermitteln
��
Merk = ActiveCell.Value
�� With ActiveCell
�����
'steht etwas darin ?
����� If Len(Merk) > 0 Then
��������
'ist das 1. Zeichen kein "�",
�������� 'dann
"�" voran stellen
��������
If Asc(Mid(Merk, 1, 1)) <> 241 Then .Value = "� " & Merk
����� Else
��������
'ansonsten nur Durchmesserzeichen
��������
.Value = "� "
����� End If
�� End With
End Sub
Schritt 5
Zum Schluss speichern Sie die Datei ab und k�nnen Sie
als
Add-In einbinden.
�
|
 Download
- 13 KB
|
| |
 |
