Værtktøjslinie knap til hævet/sænket skrift

Nej der findes desværre ikke en knap til hævet og sænket skrift i Excel.

Du kan dog når du er i cellen trykke CTRL+1. Så kan du vælge hævet og sænket skrift fra menuen (under effekter).

Et andet alternativ er at lave knytte følgende makro til en brugerdefineret knap:

Tekst omringet af {} bliver til hævet skrift
Tekst omringet af [] bliver til sænket skrift

Stil dig på en udfyldte celle og tryk på din brugerdefinerede kanp.


Sub Super_Sub()



Dim NumSub
Dim NumSuper
Dim SubL
Dim SubR
Dim SuperL
Dim SuperR
Dim CheckSub
Dim CounterSub
Dim CheckSuper
Dim CounterSuper
Dim Cell
'
CheckSub = True
CounterSub = 0
CheckSuper = True
CounterSuper = 0
Cell = ActiveCell
'
NumSub = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "[", ""))
NumSuper = Len(Cell) - Len(Application.WorksheetFunction.Substitute(Cell, "{", ""))
'
If Len(Cell) = 0 Then Exit Sub
If IsError(Application.Find("[", ActiveCell, 1)) = False Then
Do
    Do While CounterSub <= 1000
        SubL = Application.Find("[", ActiveCell, 1)
        SubR = Application.Find("]", ActiveCell, 1)
        ActiveCell.Characters(SubL, 1).Delete
        ActiveCell.Characters(SubR - 1, 1).Delete
        ActiveCell.Characters(SubL, SubR - SubL - 1).Font.Subscript = True
        CounterSub = CounterSub + 1
        If CounterSub = NumSub Then
            CheckSub = False
            Exit Do
        End If
    Loop
Loop Until CheckSub = False
End If
'
'
If IsError(Application.Find("{", ActiveCell, 1)) = False Then
Do
    Do While CounterSuper <= 1000
        SuperL = Application.Find("{", ActiveCell, 1)
        SuperR = Application.Find("}", ActiveCell, 1)
        ActiveCell.Characters(SuperL, 1).Delete
        ActiveCell.Characters(SuperR - 1, 1).Delete
        ActiveCell.Characters(SuperL, SuperR - SuperL - 1).Font.Superscript = True
        CounterSuper = CounterSuper + 1
        If CounterSuper = NumSuper Then
            CheckSuper = False
            Exit Do
        End If
    Loop
Loop Until CheckSuper = False
End If
'
End Sub


...Det er næsten lettere at benytte CTRL+1

Det trist, det skal være så beværligt ! Men Tak for hjælpen, smid lige et svar

Ja, desværre.

Et svar :)

> gibber
Vil du sende et svar ?

lukker