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.

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.