VBA - USER DEFINED FUNCTIONS

OBJEKTE:   ZELL-FORMATE

Option Explicit
Public Const MaxSpalten = 256 ' maximale SpaltenAnzahl
Public Const MaxZeilen = 65536 ' maximale ZeilenAnzahl

Sub ZeichensatzVergrößern()
Dim Bereich As Range, Areal As Range
If Selection Is Nothing Then Exit Sub
    For Each Areal In Selection.Areas
        For Each Bereich In Areal
            Bereich.Font.Size = Bereich.Font.Size + 2
        Next Bereich
Next Areal
End Sub

Sub ZeichensatzVerkleinern()
Dim Bereich As Range, Areal As Range
If Selection Is Nothing Then Exit Sub
    For Each Areal In Selection.Areas
        For Each Bereich In Areal
            Bereich.Font.Size = Bereich.Font.Size - IIf(Bereich.Font.Size < 3, 0, 2)
        Next Bereich
    Next Areal
End Sub

Sub FettKursiv() 'wechselt zw. normal, fett, kursiv + fett-kursiv
Dim bld, ital
If Selection Is Nothing Then Exit Sub
bld = Selection.Font.Bold: ital = Selection.Font.Italic
If Not bld And Not ital Then
    bld = True
ElseIf bld And Not ital Then
    ital = True: bld = False
ElseIf Not bld And ital Then
    bld = True
Else
    bld = False: ital = False
End If
Selection.Font.Bold = bld: Selection.Font.Italic = ital
End Sub

Sub SpezialSchrift()
Dim i As Long ' Index
If IsEmpty(ActiveCell.Value) Or ActiveCell.HasFormula Then Exit Sub
If IsNumeric(ActiveCell.Value) Then Exit Sub
For i = 1 To ActiveCell.Characters.Count
    ActiveCell.Characters(i, 1).Font.Size = 9 + i
Next i
End Sub

Sub SpezialSchriftImmerKleiner()
Dim i As Long ' Index
If IsEmpty(ActiveCell.Value) Or ActiveCell.HasFormula Then Exit Sub
If IsNumeric(ActiveCell.Value) Then Exit Sub
For i = 1 To ActiveCell.Characters.Count
    ActiveCell.Characters(i, 1).Font.Size = 40 - IIf(i < 40, i * 2, 0)
Next i
End Sub