Wikibooks

Plattenbeulen/ Der Code

< Plattenbeulen
Allgemein:Inhaltsverzeichnis ; Glossar ; Zahlen
Rechenbeispiel: Allgemeiner Lösungsweg ; erstes ; zweites ; drittes ; viertes
Verschiedenes: Ziel des Lehrbuches ; Tipps ; Tools ; Berechnung der semiplastischen Tragfähigkeit ; Auswertung ; Verzeichnisse

So wandelt man das Bild in ein Worddocxument um.
Das Bild wird als Windowsbitmap BMP gespeichert und dann mit einem Hexeditor geöffnet. Am Anfang und am Ende der Datei müssen Zeichen gelöscht werden. Am Anfang steht „Worddocxument beginnt hier“ und am Ende „Worddocxument endet hier“. Alle Zeichen inklusive des Textes davor bzw. dahinter werden entfernt. Die Dateiendung nennt man in docx um, um sie mit Word zu öffnen.


So bekommt man die Makros ins eigene Word:

Es gibt ein kleines Makro zur Reparatur der Dokumentstruktur von http://www.kastenmaier.de/?p=142. Dieses macht bei Worddokumenten mit mehr als 100 Seiten möglich, dass weiterhin ein Inhaltsverzeichnis aus Überschriften erstellt werden kann. Dieses Makro kommt ins Worddokument und nicht in Word. Dazu markiert und kopiert man von „Public Sub Reparatur()“ bis „End Sub“. Dann drückt man Alt F11 um den VBA-Editor zu öffnen. Oben links doppelklickt man auf Modul 1. Rechts ist ein weißer Bereich, in den man den Text einfügt. Die eigentlichen Tools (die anderen 39 Seiten) werden unter NewMacros eingefügt. Dann geht man auf Extras – Anpassen und klickt unten auf Tastatur. Da scrollt man runter und klickt auf Makros. Nun kann man den Makros Tastenkürzel zuweisen. KKTformelumwandler erhöht das Formellevel. KKTfurmelumwandler senkt das Formellevel. Ausrechnen rechnet eine Formel aus und vAusrechnen rechnet eine Formel aus und schreibt die Formel links neben das Ergebnis. 

Public Sub Reparatur()
    On Error GoTo NoDocumentOpen
    If Len(ActiveDocument.Name) = 0 Then GoTo NoDocumentOpen
 
    ' Bildschirmaktualisierung ausschalten
    Application.ScreenUpdating = False
    
    ' Gesamten Text im Dokument markieren
    Selection.WholeStory
    ' Gliederungsebene auf Textkörper ändern
    Selection.ParagraphFormat.OutlineLevel = wdOutlineLevelBodyText

NoDocumentOpen:
    ' Bildschirmaktualisierung einschalten
    Application.ScreenUpdating = True
End Sub

Option Explicit




Function Klammer(ByVal a As String) As Integer

If a = "(" Then
Klammer = 1
ElseIf a = ")" Then
Klammer = -1
ElseIf a = "" Then
Klammer = 17000
Else
Klammer = 0
End If

End Function

Function Klammer2(ByVal a As String) As Integer

If a = "{" Then
Klammer2 = 1
ElseIf a = "}" Then
Klammer2 = -1
ElseIf a = "" Then
Klammer2 = 17000
Else
Klammer2 = 0
End If

End Function

Function Steuerzeichen(ByVal a As String) As Integer

Select Case a
Case "+", "-", "*", "•", "/", ")", "(", "^", "_", "=", ChrW(8729), ChrW(8211)
Steuerzeichen = 1
Case ""
Steuerzeichen = 17000
Case Else
Steuerzeichen = 0
End Select

End Function

Function IstZahl(ByVal a As String) As Integer

Select Case a
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", ","
IstZahl = 1
Case ""
IstZahl = 17000
Case Else
IstZahl = 0
End Select

End Function

Function Typ() As Integer
Dim Länge, aktuellZeichen, c, d, e As Integer
Dim Formel, Tz As String

If Selection.Fields.Count = 1 Then
    Formel = Selection.Fields(1).Code
    Typ = 0 'Elementar (Berechnungsfeld)
    For c = 1 To 3
     Tz = Mid(Formel, c, 3)
     If Tz = "EQ " Then
     Typ = 2 'EQ Feld
     End If
    Next
    Exit Function
End If

Formel = Selection
Länge = Len(Formel)
For c = 1 To 3
 Tz = Mid(Formel, c, 8)
  '
   If Tz = ":<math> " Then
   '
  Typ = 3 'Wikipedia
  Exit Function
  End If
 Tz = Mid(Tz, 1, 3)
  If Tz = "EQ " Then
  Typ = 2 'EQ Feld
  Exit Function
  End If
Next

d = 0 'elementare Zeichen
e = 0 'chicke Zeichen
For aktuellZeichen = Länge To 1 Step -1
    Tz = Mid(Formel, aktuellZeichen, 1)
    Select Case Tz
    Case "^", "_", "*"
    d = d + 1
    Case "²", "³", "•", ChrW(8729)
    e = e + 1
    End Select
Next
If Selection.Font.Superscript = False Then
d = d + 0
Else
e = e + 1
End If

If d = 0 And e = 0 Then Typ = -1 'elementar = chick
If d = 0 And e <> 0 Then Typ = 1 'chick
If d <> 0 And e = 0 Then Typ = 0 'elementar
If d <> 0 And e <> 0 Then Typ = 10 'elementarchick

End Function

Function Starten() As String
Dim Länge, aktuellZeichen, Klammersumme, Formeltyp, c, d, e As Integer
Dim Formel, Tz As String

If Selection.Fields.Count = 1 Then
    Formel = Selection.Fields(1).Code
    Else
    Formel = Selection
    Länge = Len(Formel)
    If Länge = 1 Then 'markiert bis zum ende
     Selection.EndKey Unit:=wdLine, Extend:=wdExtend
     Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
     Formel = Selection
     Länge = Len(Formel)
    End If
    If Länge = 1 Then ' markiert bei Fehlschlag bis zum Tab oder =
     Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
     Formel = Selection
     Länge = Len(Formel)
     d = 0
     For e = Länge To 1 Step -1
        Tz = Mid(Formel, e, 1)
        If Asc(Tz) = 9 Or Asc(Tz) = 61 Then Exit For
        d = d + 1
     Next
     Selection.Collapse
     Selection.MoveRight Unit:=wdCharacter, Count:=Länge - d
     Selection.MoveRight Unit:=wdCharacter, Count:=d, Extend:=wdExtend
    End If
End If

Tz = Right(Formel, 1) 'prüft, ob rechts ein Absatz ist
c = Asc(Tz)
If c = 11 Or c = 13 Then
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    'Tz = Formel
    Formel = Selection
    'Länge = Len(Formel)
    If Länge - Len(Formel) = -1 Then
    Länge = Len(Formel)
    Selection.Collapse
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=Länge - 2, Extend:=wdExtend
    'c = MsgBox("Absatz markiert", 17, "Warnung")
    'If c = 2 Then Exit Function
    End If
End If
Tz = Left(Formel, 1) 'prüft, ob links ein Absatz ist
c = Asc(Tz)
If c = 11 Or c = 13 Then
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    'Tz = Formel
    Formel = Selection
    'Länge = Len(Formel)
    If Länge - Len(Formel) = -1 Then
    Länge = Len(Formel)
    Selection.Collapse
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveRight Unit:=wdCharacter, Count:=Länge - 2, Extend:=wdExtend
    'c = MsgBox("Absatz markiert", 17, "Warnung")
    'If c = 2 Then Exit Function
    End If
End If

'Sicherung gegen Klammern
Klammersumme = 0
Länge = Len(Formel)
For aktuellZeichen = 1 To Länge
    Tz = Mid(Formel, aktuellZeichen, 1)
    Klammersumme = Klammersumme + Klammer(Tz) + Klammer2(Tz)
    If Klammersumme < 0 Then Exit For
Next
If Klammersumme <> 0 Then
c = MsgBox("Es sind " & Klammersumme & " Klammern zuviel", vbCritical, "Warnung")
Starten = " "
Exit Function
End If

Starten = Formel

End Function

Sub ausrechnen()
Dim Länge, aktuellZeichen, Klammersumme, Formeltyp, c, d, e As Integer
Dim Formel, Tz As String

Application.ScreenUpdating = False
Formel = Starten()
If Formel = " " Then Exit Sub
Formeltyp = Typ()

'Reversetranslatase und RNApolymerase können eine (1) in Klammern haben
'Dadurch erzeugen sie ein EQ-Feld ohne Feld und sind damit schneller

'senkt den Formeltyp auf elementar
Select Case Formeltyp
    Case 3
    d = Reversetranslatase(1) + Reversetransskriptase() + DNAse()
    Case 2
    d = Reversetransskriptase() + DNAse()
    Case 1, 10
    d = DNAse()
    Case 0, -1
    d = 0
End Select
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    PreserveFormatting:=False
Selection.TypeText Text:="= "
Selection.Fields.ToggleShowCodes
Selection.Fields.Update


Application.ScreenUpdating = True

End Sub

Sub vausrechnen()
Dim Länge, aktuellZeichen, Klammersumme, Formeltyp, c, d, e As Integer
Dim Formel, Tz As String

Application.ScreenUpdating = False
Formel = Starten()
If Formel = " " Then Exit Sub
Formeltyp = Typ()

'senkt den Formeltyp auf elementar
Select Case Formeltyp
    Case 3
    d = Reversetranslatase(1) + Reversetransskriptase() + DNAse()
    Case 2
    d = Reversetransskriptase() + DNAse()
    Case 1, 10
    d = DNAse()
    Case 0, -1
    d = 0
End Select
Formel = Selection
Länge = Len(Formel)
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    PreserveFormatting:=False
Selection.TypeText Text:="= "
Selection.Fields.ToggleShowCodes
Selection.Fields.Update

Selection.TypeText (Formel) & "=" & Chr(9)
Selection.MoveLeft Unit:=wdCharacter, Count:=2
Selection.MoveLeft Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend

'stellt wahrscheinlich das EQ-Feld wieder her
c = 0
For aktuellZeichen = Länge - 2 To 1 Step -1
    Tz = Mid(Formel, aktuellZeichen, 1)
    If Tz = "/" Then
    c = 1
    Exit For
    End If
Next
If c = 0 Then
    For aktuellZeichen = Länge - 3 To 1 Step -1
    Tz = Mid(Formel, aktuellZeichen, 3)
    If Tz = "0,5" Or Tz = "^1/" Then
    c = 1
    Exit For
    End If
    Next
End If
If c = 1 Then
d = DNApolymerase() + RNApolymerase(0)
Else
d = DNApolymerase()
End If

Application.ScreenUpdating = True

End Sub

Sub KKTformelumwandler()
'erhöht den Formeltyp
Dim Länge, aktuellZeichen, Klammersumme, Formeltyp, c, d, e As Integer
Dim Formel, Tz As String

Application.ScreenUpdating = False
Formel = Starten()
If Formel = " " Then Exit Sub

Formeltyp = Typ()
Länge = Len(Formel)
Select Case Formeltyp
    Case -1, 10
    d = DNApolymerase() + RNApolymerase(0)
    Case 1
    d = RNApolymerase(0)
    Case 2
    d = Ribosom()
    Case 3
    d = Reversetranslatase(1) + Reversetransskriptase() + DNAse()
    Case 0
    Formel = Selection
    c = 0
    For aktuellZeichen = Länge - 2 To 1 Step -1
        Tz = Mid(Formel, aktuellZeichen, 1)
        If Tz = "/" Then
        c = 1
        Exit For
        End If
    Next
    If c = 0 Then
        For aktuellZeichen = Länge - 3 To 1 Step -1
        Tz = Mid(Formel, aktuellZeichen, 3)
        If Tz = "0,5" Or Tz = "^1/" Then
        c = 1
        Exit For
        End If
        Next
    End If
    If c = 1 Then
    d = DNApolymerase() + RNApolymerase(0)
    Else
    d = DNApolymerase()
    End If
End Select
Application.ScreenUpdating = True

End Sub

Sub KKTfurmelumwandler()
'senkt den Formeltyp
Dim Länge, aktuellZeichen, Klammersumme, Formeltyp, c, d, e As Integer
Dim Formel, Tz As String

Application.ScreenUpdating = False
Formel = Starten()
If Formel = " " Then Exit Sub

Formeltyp = Typ()
Select Case Formeltyp
    Case 3
    d = Reversetranslatase(0)
    Case 2
    d = Reversetransskriptase()
    Case 1, 10
    d = DNAse()
    Case 0, -1
    d = DNApolymerase() + RNApolymerase(1) + Ribosom()
End Select
Application.ScreenUpdating = True

End Sub

Function DNApolymerase() As Integer
'Elementar zu chick
Dim Länge, Verkürzung, Endzeichen, aktuellZeichen, Klammersumme, c, d As Integer
Dim Zeichen, Formel, Tz As String

DNApolymerase = 1

'Tauscht ^2 und ^3 gegen ² und ³ aus
Formel = Selection
Länge = Len(Formel)
For aktuellZeichen = Länge - 1 To 2 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "^" Then
Zeichen = Mid(Formel, aktuellZeichen + 2, 1)
If IstZahl(Zeichen) = 0 Then
 If Selection.Characters(aktuellZeichen + 1) = "2" Then
 Selection.Characters(aktuellZeichen) = "²"
 Selection.Characters(aktuellZeichen + 1) = ""
 ElseIf Selection.Characters(aktuellZeichen + 1) = "3" Then
 Selection.Characters(aktuellZeichen) = "³"
 Selection.Characters(aktuellZeichen + 1) = ""
 End If
End If
End If
Next

' Ersetzt * durch •
Formel = Selection
Länge = Len(Formel)
aktuellZeichen = 1
For aktuellZeichen = Länge - 1 To 2 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "*" Then
Selection.Characters(aktuellZeichen) = "•"
End If
Next

'stellt hochtief
aktuellZeichen = 1
For aktuellZeichen = Länge - 1 To 2 Step -1
Verkürzung = 0
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "^" Then
    d = 1
    ElseIf Tz = "_" Then
    d = -1
    Else
    d = 0
End If
If d <> 0 Then
    Tz = Mid(Formel, aktuellZeichen + 1, 1)
    If Tz = " " Then
    Selection.Characters(aktuellZeichen + 1) = ""
    Formel = Selection
    Tz = Mid(Formel, aktuellZeichen + 1, 1)
    End If
    Selection.Characters(aktuellZeichen) = "" '+1 im string
    If Tz = "(" Then
    Klammersumme = 1
    Selection.Characters(aktuellZeichen) = ""
    While Klammersumme > 0
        If d = 1 Then
            Selection.Characters(aktuellZeichen).Font.Superscript = True
            ElseIf d = -1 Then
            Selection.Characters(aktuellZeichen).Font.Subscript = True
        End If
        aktuellZeichen = aktuellZeichen + 1
        Verkürzung = Verkürzung + 1
        Tz = Mid(Formel, aktuellZeichen + 2, 1)
        Klammersumme = Klammersumme + Klammer(Tz)
        If Tz = "^" Then
        Selection.Characters(aktuellZeichen).InsertBefore Tz
        d = 0
        ElseIf Tz = "_" Then
        Selection.Characters(aktuellZeichen).InsertBefore Tz
        d = 0
        End If
    Wend
    Selection.Characters(aktuellZeichen) = ""
    aktuellZeichen = aktuellZeichen - Verkürzung
    Else 'Tz <> "("
    Tz = Mid(Formel, aktuellZeichen + 1, 1)
    c = Steuerzeichen(Tz)
    If Tz = "²" Or Tz = "³" Then c = 1
    While c = 0
        If d = 1 Then
            Selection.Characters(aktuellZeichen).Font.Superscript = True
            Else
            Selection.Characters(aktuellZeichen).Font.Subscript = True
        End If
        aktuellZeichen = aktuellZeichen + 1
        Verkürzung = Verkürzung + 1
        Tz = Mid(Formel, aktuellZeichen + 1, 1)
        c = Steuerzeichen(Tz)
        If Tz = "²" Or Tz = "³" Then c = 1
        If Tz = "" Then
        c = 1
        End If
    Wend
    aktuellZeichen = aktuellZeichen - Verkürzung
    End If
End If
Next

End Function

Function DNAse() As Integer
'Chick zu elementar
Dim Länge, aktuellZeichen As Integer
Dim c, d, Endzeichen As Integer
Dim Zeichen, Formel, Tz As String

DNAse = 1

d = Selection.Fields.Count
If d = 1 Then
Selection.Fields.ToggleShowCodes
Selection.Fields(1).Code.Select
Länge = Selection.Characters.Count
With Selection
    .Cut
    .MoveRight Unit:=wdCharacter, Count:=1
    .TypeBackspace
    .TypeBackspace
    .Paste
    .MoveLeft Unit:=wdCharacter, Count:=Länge - 2, Extend:=wdExtend
End With
 Formel = Selection
 Länge = Länge - 2
 Tz = Mid(Formel, Länge, 1)
 If Tz = " " Then
 Selection.Characters(Länge) = ""
 End If
 Tz = Mid(Formel, 1, 1)
 If Tz = "Q" Then
 Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
 End If
End If

Formel = Selection
Länge = Len(Formel)
For c = 1 To 3
 Tz = Mid(Formel, c, 3)
  If Tz = "EQ " Then
  d = 1 'EQ Feld ohne Feld und es werden {} statt () verwendet
  End If
Next

' Ersetzt • durch *
aktuellZeichen = 2
For aktuellZeichen = 2 To Länge - 1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "•" Or Tz = ChrW(8729) Then
Selection.Characters(aktuellZeichen) = "*"
End If
Next

'Ersetzt ²³ durch ^2^3
For aktuellZeichen = Länge To 1 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "²" Then
Selection.Characters(aktuellZeichen).InsertBefore ("^2")
Selection.Characters(aktuellZeichen + 2) = ""
ElseIf Tz = "³" Then
Selection.Characters(aktuellZeichen).InsertBefore ("^3")
Selection.Characters(aktuellZeichen + 2) = ""
End If
Next

'Entstellt hoch
Formel = Selection
Länge = Len(Formel)
For aktuellZeichen = Länge To 1 Step -1
    If Selection.Characters(aktuellZeichen).Font.Superscript = True Then
    Endzeichen = aktuellZeichen
    c = 0
    While Selection.Characters(aktuellZeichen).Font.Superscript = True
        c = c + Steuerzeichen(Selection.Characters(aktuellZeichen))
        Selection.Characters(aktuellZeichen).Font.Superscript = False
        aktuellZeichen = aktuellZeichen - 1
    Wend
    If d = 1 Then
        If Endzeichen - aktuellZeichen = 1 Then
        Selection.Characters(aktuellZeichen).InsertAfter ("^")
        Else
        Tz = Mid(Formel, Endzeichen, 1)
        Selection.Characters(Endzeichen).InsertBefore ("}")
        Selection.Characters(Endzeichen).InsertBefore (Tz)
        Selection.Characters(Endzeichen + 2) = ""
        Selection.Characters(aktuellZeichen).InsertAfter ("^{")
        End If
    Else
        If c > 0 Then
        Tz = Mid(Formel, Endzeichen, 1)
        Selection.Characters(Endzeichen).InsertBefore (")")
        Selection.Characters(Endzeichen).InsertBefore (Tz)
        Selection.Characters(Endzeichen + 2) = ""
        Selection.Characters(aktuellZeichen).InsertAfter ("^(")
        Else
        Selection.Characters(aktuellZeichen).InsertAfter ("^")
        End If
    End If
    End If
Next

'Entstellt tief
Formel = Selection
Länge = Len(Formel)
For aktuellZeichen = Länge To 1 Step -1
    If Selection.Characters(aktuellZeichen).Font.Subscript = True Then
    Endzeichen = aktuellZeichen
    c = 0
    While Selection.Characters(aktuellZeichen).Font.Subscript = True
        c = c + Steuerzeichen(Selection.Characters(aktuellZeichen))
        Selection.Characters(aktuellZeichen).Font.Subscript = False
        aktuellZeichen = aktuellZeichen - 1
    Wend
    If d = 1 Then
        If Endzeichen - aktuellZeichen = 1 Then
        Selection.Characters(aktuellZeichen).InsertAfter ("_")
        Else
        Tz = Mid(Formel, Endzeichen, 1)
        Selection.Characters(Endzeichen).InsertBefore ("}")
        Selection.Characters(Endzeichen).InsertBefore (Tz)
        Selection.Characters(Endzeichen + 2) = ""
        Selection.Characters(aktuellZeichen).InsertAfter ("_{")
        End If
    Else
        If c > 0 Then
        Tz = Mid(Formel, Endzeichen, 1)
        Selection.Characters(Endzeichen).InsertBefore (")")
        Selection.Characters(Endzeichen).InsertBefore (Tz)
        Selection.Characters(Endzeichen + 2) = ""
        Selection.Characters(aktuellZeichen).InsertAfter ("_(")
        Else
        Selection.Characters(aktuellZeichen).InsertAfter ("_")
        End If
    End If
    End If
Next

End Function

Function RNApolymerase(ByVal Hemmung As Integer) As Integer
'Chick zu EQ
Dim Länge, Widerherstellen, Verkürzung, aktuellZeichen, aktuellZeichen2, Klammersumme As Integer
Dim c, d, e, Endzeichen, Azeichen, Tausch As Integer
Dim Zeichen, Formel, Tz As String

RNApolymerase = 1

'bearbeitet Quadratwurzeln
Länge = Len(Selection)
Formel = Selection
aktuellZeichen = Länge
aktuellZeichen2 = Länge - 4
For aktuellZeichen = Länge To 3 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "5" Then
Tz = Mid(Formel, aktuellZeichen - 1, 1)
If Tz = "," Then
If Selection.Characters(aktuellZeichen - 2).Font.Superscript = True Then
If Selection.Characters(aktuellZeichen - 2) = "0" Then
 If aktuellZeichen = Länge Then
    e = 1
    ElseIf Selection.Characters(aktuellZeichen + 1).Font.Superscript = False Then
    e = 1
    Else
    e = 0
 End If
If e = 1 Then
If Selection.Characters(aktuellZeichen - 3).Font.Superscript = True Then
If Selection.Characters(aktuellZeichen - 3) = "^" Then
Selection.Characters(aktuellZeichen - 3) = ""
aktuellZeichen = aktuellZeichen - 1
End If
End If
End If
If e = 1 Then
Selection.Characters(aktuellZeichen - 2) = ""
Formel = Selection
Tz = Mid(Formel, aktuellZeichen - 3, 1)
If Tz = ")" Then
    Selection.Characters(aktuellZeichen - 2) = ""
    Selection.Characters(aktuellZeichen - 2) = ""
    Klammersumme = -1
    aktuellZeichen2 = aktuellZeichen - 4
    While Klammersumme <> 0
    Tz = Mid(Formel, aktuellZeichen2, 1)
    Klammersumme = Klammersumme + Klammer(Tz)
    aktuellZeichen2 = aktuellZeichen2 - 1
    Wend
    If aktuellZeichen2 < 2 Then
        Widerherstellen = Len(Selection) + 3
        Selection.Characters(aktuellZeichen2 + 1) = "\r(;"
        If Len(Selection) = 1 Then
        Selection.MoveRight Unit:=wdCharacter, Count:=Widerherstellen, Extend:=wdExtend
        End If
        Else
        If Selection.Characters(aktuellZeichen2 - 1) = "\" Then
        Widerherstellen = Len(Selection) + 4
        Selection.Characters(aktuellZeichen2 - 1).InsertBefore ("\r(;")
        If Len(Selection) = 1 Then
        Selection.MoveRight Unit:=wdCharacter, Count:=Widerherstellen, Extend:=wdExtend
        End If
        Selection.Characters(aktuellZeichen).InsertAfter (")")
        aktuellZeichen = aktuellZeichen + 2
        Else
        Selection.Characters(aktuellZeichen2 + 1) = "\r(;"
        End If
    End If
Else
    c = 0
    aktuellZeichen2 = aktuellZeichen - 3
    Selection.Characters(aktuellZeichen - 2) = ")"
    Selection.Characters(aktuellZeichen - 1) = ""
    Selection.Characters(aktuellZeichen - 2).Font.Superscript = False
    While c = 0
    Tz = Mid(Formel, aktuellZeichen2, 1)
    c = Steuerzeichen(Tz)
    aktuellZeichen2 = aktuellZeichen2 - 1
    If aktuellZeichen2 = 0 Then
    c = 1
    End If
    Wend
    If aktuellZeichen2 = 0 Then
    Selection.Characters(1).InsertBefore ("\r(;")
    Else
    Selection.Characters(aktuellZeichen2 + 1).InsertAfter ("\r(;")
    End If
End If
End If
End If
End If
End If
End If
If aktuellZeichen2 = 0 Then
Exit For
End If
Next

'bearbeitet Wurzeln
Länge = Len(Selection)
Formel = Selection
aktuellZeichen = Länge - 2
For aktuellZeichen = Länge - 2 To 2 Step -1
c = 0
Tausch = 0
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "1" Then
Tz = Mid(Formel, aktuellZeichen + 1, 1)
If Tz = "/" Then
If Selection.Characters(aktuellZeichen).Font.Superscript = True Then
If Selection.Characters(aktuellZeichen - 1).Font.Superscript = False Then
    While c = 0
        If Länge < aktuellZeichen + Tausch + 2 Then
        c = 1
        ElseIf Selection.Characters(aktuellZeichen + Tausch + 2).Font.Superscript = False Then
        c = 1
        Else
        c = 0
        End If
        Tausch = Tausch + 1
    Wend
    Tausch = Tausch - 1
    Selection.Characters(aktuellZeichen) = ""
    Selection.Characters(aktuellZeichen) = ")"
    Selection.Characters(aktuellZeichen).Font.Superscript = False
    Tz = Mid(Formel, aktuellZeichen - 1, 1)
    If Tz = ")" Then
        Selection.Characters(aktuellZeichen) = ""
        Klammersumme = -1
        aktuellZeichen2 = aktuellZeichen - 2
        While Klammersumme <> 0
        Tz = Mid(Formel, aktuellZeichen2, 1)
        Klammersumme = Klammersumme + Klammer(Tz)
        aktuellZeichen2 = aktuellZeichen2 - 1
        Wend
        If aktuellZeichen2 < 2 Then
            Widerherstellen = Len(Selection) + 2
            Selection.Characters(aktuellZeichen2 + 1) = "\r("
            If Len(Selection) = 1 Then
            Selection.MoveRight Unit:=wdCharacter, Count:=Widerherstellen, Extend:=wdExtend
            End If
        Else
            If Selection.Characters(aktuellZeichen2 - 1) = "\" Then
            aktuellZeichen2 = aktuellZeichen2 - 2
            Widerherstellen = Len(Selection) + 3
            Selection.Characters(aktuellZeichen2 + 1) = "\r(\"
            If Len(Selection) = 1 Then
            Selection.MoveRight Unit:=wdCharacter, Count:=Widerherstellen, Extend:=wdExtend
            End If
            Selection.Characters(aktuellZeichen + 2).InsertAfter (")")
            aktuellZeichen = aktuellZeichen + 2
            Else
            Selection.Characters(aktuellZeichen2 + 1) = "\r("
            End If
        End If
        aktuellZeichen = aktuellZeichen + 2
        d = 1
        For d = 1 To Tausch
        Selection.Characters(aktuellZeichen2 + 3).InsertAfter (Selection.Characters(aktuellZeichen + Tausch - 1))
        Selection.Characters(aktuellZeichen + Tausch) = ""
        Next
        Selection.Characters(aktuellZeichen2 + 3 + Tausch).InsertAfter (";")
    Else
        aktuellZeichen2 = aktuellZeichen - 2
        c = 0
        If aktuellZeichen2 <> 0 Then
            While c = 0
            Tz = Mid(Formel, aktuellZeichen2, 1)
            c = Steuerzeichen(Tz)
            If Tz = ";" Then
            c = 1
            End If
            aktuellZeichen2 = aktuellZeichen2 - 1
            If aktuellZeichen2 = 0 Then
            c = 1
            End If
            Wend
        End If
        Widerherstellen = Len(Selection) + 2
        If aktuellZeichen2 = 0 Then
            Selection.Characters(1).InsertBefore ("\r(")
            aktuellZeichen2 = aktuellZeichen2 - 1
            Else
            Selection.Characters(aktuellZeichen2 + 1).InsertAfter ("\r(")
        End If
        aktuellZeichen = aktuellZeichen + 3
        If Len(Selection) = 1 Then
        Selection.MoveRight Unit:=wdCharacter, Count:=Widerherstellen, Extend:=wdExtend
        End If
        d = 1
        For d = 1 To Tausch
        Selection.Characters(aktuellZeichen2 + 4).InsertAfter (Selection.Characters(aktuellZeichen + Tausch))
        Selection.Characters(aktuellZeichen + Tausch + 1) = ""
        Next
        Selection.Characters(aktuellZeichen2 + 4 + Tausch).InsertAfter (";")
    End If
End If
Formel = Selection
End If
End If
End If
Next

'Wandelt Brüche um
Länge = Len(Selection)
aktuellZeichen = Länge - 1
For aktuellZeichen = Länge - 1 To 2 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "/" Then
 If Selection.Characters(aktuellZeichen + 1) = " " Then
 Selection.Characters(aktuellZeichen + 1) = ""
 Länge = Länge - 1
 End If
 If Selection.Characters(aktuellZeichen - 1) = " " Then
 Selection.Characters(aktuellZeichen - 1) = ""
 aktuellZeichen = aktuellZeichen - 1
 Länge = Länge - 1
 End If
 Formel = Selection
'bearbeitet die rechte Seite
'345/54334-123  -> 0) 345/54334)-123
'345/54334      -> 0) 345/54334)
'345/5433^34    -> 0) 345/5433^34)
'345/(3+5)      -> -0 345/3+5)
'243/(4*6)      -> -0 243/4*6)
'345/(3+5)^4    -> 0) 345/(3+5)^4)
'354/\r(;23)    -> 0) 354/\r(;23))
'354/\r(;23)^56 -> 0) 354/\r(;23)56^)
Verkürzung = 0
Tz = Mid(Formel, aktuellZeichen + 1, 1)
If Tz = "-" Then
aktuellZeichen = aktuellZeichen + 1
Verkürzung = 1 'berücksichtigt nevatives Vorzeichen
End If
Tz = Mid(Formel, aktuellZeichen + 1, 1)
If Tz = "(" Then
    e = 1
    ElseIf Tz = "\" Then 'geändert
    e = 2 'e entscheidet, wo klammern gesetzt werden
    Else
    e = 0
End If 'aktuellzeichen = / oder -
If e <> 0 Then
    If e = 2 Then
    Endzeichen = aktuellZeichen + 3
    Else
    Endzeichen = aktuellZeichen + 1
    End If
    Klammersumme = 1
    While Klammersumme <> 0
    Endzeichen = Endzeichen + 1
    Tz = Mid(Formel, Endzeichen, 1)
    Klammersumme = Klammersumme + Klammer(Tz)
    Wend
    c = 0
    d = 0 'd= hochtiefstellung
    If Endzeichen < Länge Then
        While c = 0
        Endzeichen = Endzeichen + 1
        If Endzeichen > Länge Then
        c = 1
        ElseIf Selection.Characters(Endzeichen).Font.Superscript = True Then
        c = 0
        d = 1
        ElseIf Selection.Characters(Endzeichen).Font.Subscript = True Then
        c = 0
        d = -1
        ElseIf Selection.Characters(Endzeichen) = "²" Then
        c = 0
        d = 2
        ElseIf Selection.Characters(Endzeichen) = "³" Then
        c = 0
        d = 2
        Else
        c = 1
        End If
        Wend
    End If
    Endzeichen = Endzeichen - 1
    If d <> 0 Or e = 2 Then
        Selection.Characters(Endzeichen - 1).InsertAfter ("))")
        Selection.Characters(Endzeichen) = Selection.Characters(Endzeichen + 2)
        Selection.Characters(Endzeichen + 2) = ""
        If d = 1 Then
        Selection.Characters(Endzeichen).Font.Superscript = True
        ElseIf d = -1 Then
        Selection.Characters(Endzeichen).Font.Subscript = True
        ElseIf d = 2 Then
        Selection.Characters(Endzeichen).Font.Subscript = False
        Selection.Characters(Endzeichen).Font.Superscript = False
        End If
        Selection.Characters(Endzeichen + 1).Font.Subscript = False
        Selection.Characters(Endzeichen + 1).Font.Superscript = False
    Else
        Selection.Characters(aktuellZeichen + 1) = ""
    End If
Else
    Endzeichen = aktuellZeichen
    c = 0
    While c = 0
        Endzeichen = Endzeichen + 1
        If Endzeichen > Länge Then
        c = 1
        Else
        Tz = Mid(Formel, Endzeichen, 1)
        c = Steuerzeichen(Tz)
        End If
    Wend
    If Endzeichen > Länge - 1 Then
        Endzeichen = Endzeichen - 1
    Else
        If Selection.Characters(Endzeichen) = "(" And Selection.Characters(Endzeichen - 2) = "\" Then
        Endzeichen = Endzeichen - 3
        Else
        Endzeichen = Endzeichen - 1
        End If
    End If
    If Endzeichen = Länge Then
        If Selection.Characters(Endzeichen).Font.Subscript = True Then
        With Selection
            .Characters(Endzeichen - 1).InsertAfter ("))")
            .Characters(Endzeichen) = Selection.Characters(Endzeichen + 2)
            .Characters(Endzeichen).Font.Subscript = True
            .Characters(Endzeichen + 1).Font.Subscript = False
            .Characters(Endzeichen + 1).Font.Superscript = False
            .Characters(Endzeichen + 2) = ""
        End With
        ElseIf Selection.Characters(Endzeichen).Font.Superscript = True Then
        With Selection
            .Characters(Endzeichen - 1).InsertAfter ("))")
            .Characters(Endzeichen) = Selection.Characters(Endzeichen + 2)
            .Characters(Endzeichen).Font.Superscript = True
            .Characters(Endzeichen + 1).Font.Superscript = False
            .Characters(Endzeichen + 1).Font.Subscript = False
            .Characters(Endzeichen + 2) = ""
        End With
        Else
        With Selection
            .Characters(Endzeichen - 1).InsertAfter ("))")
            .Characters(Endzeichen) = Selection.Characters(Endzeichen + 2)
            .Characters(Endzeichen + 2) = ""
            .Characters(Endzeichen).Font.Superscript = False
            .Characters(Endzeichen).Font.Subscript = False
            .Characters(Endzeichen + 1).Font.Superscript = False
            .Characters(Endzeichen + 1).Font.Subscript = False
        End With
        End If
    Else
        Selection.Characters(Endzeichen).InsertAfter (")")
        Selection.Characters(Endzeichen + 1).Font.Subscript = False
        Selection.Characters(Endzeichen + 1).Font.Superscript = False
    End If
End If 'aktuellzeichen wird wieder /
aktuellZeichen = aktuellZeichen - Verkürzung
'bearbeitet die linke Seite und berücksichtigt folgende Fälle
'345/dfg                 (0  \F(345;dfg)
'2+354/wer               (0  2+\F(354;wer)
'(2+345)/rzt             0-  \F(2+345;rzt)
'3+(2+345)/rzt           0-  3+\F(2+345;rzt)
'24^3/46                 (0  \F(24^3;46)
'(3+23)^54/234           (0  \F((3+23)^54;234)
'\r(;354)/234            (0  \F(\r(;354);234)
'\r(;354)^0,23/234       (0  \F(\r(;354)^0,23;234)
'\o(L;\s\up4(_))/4365    (0  \F(\o(L;\s\up4(_));4365)
'\o(L;\s\up4(_))_as/4365 (0  \F(\o(L;\s\up4(_))_as;4365)
'\s\up4(_)/4365          (0  \F(\s\up4(_);4365)
'4*6/45                  (0  \F(4*6;45)
'2+(3+8)*5/123           (0  2+\F((3+8)*5;123)
'2+5*(3+8)/21            (0  2+\F(5*(3+8);21)
'(2+5)*(7+s)/afd         (0  \F((2+5)*(7+s);afd) extra
'4*64/asd                (0  \F(4*64;asd)
'\r(;354)*sfd/234        (0  \F(\r(;354)*sfd;234)
'3sd(345+sfd)/234        (0  \F(3sd(345+sfd);234) irreversibel für Reversetranskriptase
'4/34*465/vbn            (0  \F(\F(4;34)*465;vbn)
'4+3*(4/(3+34))          (0  4+3*(\F(4;3+34)) extra
'(345/465)^(1/234)       (0  \r(234;\F(345;465)) extra
Selection.Characters(aktuellZeichen) = ";"
Formel = Selection
c = 0
d = 0
e = 0
Azeichen = aktuellZeichen
Klammersumme = 0
While c = 0
    Azeichen = Azeichen - 1
    Tz = Mid(Formel, Azeichen, 1)
    Klammersumme = Klammersumme + Klammer(Tz)
    If Klammer(Tz) <> 0 And Klammersumme = 0 Then
    d = d + 1 'Prüft, ob zwischen den Klammern weitere Klammern enthalten sind
    End If
    If Azeichen = 1 Then
        c = 1 'berücksichtigt selbstständig negative Vorzeichen am Anfang
        If Klammersumme = 1 Then Azeichen = Azeichen + 1
    Else
        If Tz = "+" And Klammersumme = 0 Then
        c = 1
        Azeichen = Azeichen + 1
        End If
        If (Tz = ";" Or Tz = "=") And Klammersumme = 0 Then
        c = 1 'Berücksichtigt, ob der Bruch sich z.B. in einer Wurzel befindet
        Azeichen = Azeichen + 1
        End If
        If (Tz = "-" Or Tz = ChrW(8211)) And Klammersumme = 0 Then
        c = 1
        Azeichen = Azeichen + 1
        End If
        If Klammersumme = 1 Then
        c = 1
        Azeichen = Azeichen + 1
        End If
    End If 'Azeichen = beginn des Bruches
Wend
If Selection.Characters(Azeichen) = "(" And d < 2 And Selection.Characters(aktuellZeichen - 1) = ")" Then
    Selection.Characters(aktuellZeichen - 1) = ""
    If Azeichen = 1 Then
    Länge = Len(Selection)
    Selection.Characters(1).InsertBefore ("\F")
    If Len(Selection) = 1 Then
    Selection.MoveRight Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend
    End If
    Else
    Selection.Characters(Azeichen).InsertBefore ("\F")
    End If
Else
    If Azeichen = 1 Then
    Länge = Len(Selection)
    Selection.Characters(1).InsertBefore ("\F(")
    If Len(Selection) = 1 Then
    Selection.MoveRight Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend
    End If
    Else
    Selection.Characters(Azeichen).InsertBefore ("\F(")
    End If
End If
Formel = Selection
Länge = Len(Formel)
End If ' gehört zu If Tz = "/" Then
Next

'erkennt große klammern
Länge = Len(Selection)
Formel = Selection
aktuellZeichen = Länge - 2
c = 0
d = 0
e = 0
For aktuellZeichen = Länge - 2 To 1 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
    If Tz = "(" Then
        Azeichen = aktuellZeichen - 2
        If aktuellZeichen < 3 Then
            d = 1
            ElseIf Selection.Characters(Azeichen) = "\" Then
            d = 0
        Else
            e = 0
            While e = 0
            If Steuerzeichen(Selection.Characters(Azeichen + 1)) = 1 Then
            e = 1
            d = 1
            ElseIf Selection.Characters(Azeichen + 1) = "\" Then
            e = 1
            d = 0
            End If
            If Azeichen < 1 Then
            e = 1
            d = 1
            End If
            Azeichen = Azeichen - 1
            Wend
        End If
          If d = 1 Then
            d = 0
            Endzeichen = aktuellZeichen + 1
            Klammersumme = 1
            While Klammersumme <> 0
                Tz = Mid(Formel, Endzeichen, 1)
                Klammersumme = Klammersumme + Klammer(Tz)
                Endzeichen = Endzeichen + 1
            Wend
            Endzeichen = Endzeichen - 1
            e = aktuellZeichen
            For e = aktuellZeichen To Endzeichen
            Tz = Mid(Formel, e, 1)
            If Tz = "\" Then
            d = 1
            End If
            Next
          End If
        If d = 1 Then
        If Azeichen < 0 Then
            Länge = Len(Selection)
            Selection.Characters(aktuellZeichen).InsertBefore ("\b")
            If Len(Selection) = 1 Then
            Selection.MoveRight Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend
            End If
            Else
            Selection.Characters(aktuellZeichen).InsertBefore ("\b")
        End If
        End If
        
    End If
Next

Länge = Len(Selection) + 3
Selection.Characters(1).InsertBefore ("EQ ")
If Len(Selection) = 1 Then
Selection.MoveRight Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend
End If

If Hemmung = 1 Then
Else
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.Fields.Update
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End If

'Selection.MoveRight Unit:=wdCharacter, Count:=2
'Selection.EndKey Unit:=wdLine, Extend:=wdExtend
'Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

End Function

Function Reversetransskriptase() As Integer
'EQ zu Chick
Dim Länge, aktuellZeichen, Klammersumme, Tausch As Integer
Dim c, d, e, Endzeichen, Azeichen As Integer
Dim Zeichen, Formel, Tz As String

Reversetransskriptase = 1

c = Selection.Fields.Count
If c = 1 Then
 Selection.Fields.ToggleShowCodes
 Selection.Fields(1).Code.Select
 Länge = Selection.Characters.Count
 With Selection
    .Cut
    .MoveRight Unit:=wdCharacter, Count:=1
    .TypeBackspace
    .TypeBackspace
    .Paste
    .MoveLeft Unit:=wdCharacter, Count:=Länge - 2, Extend:=wdExtend
 End With
 Formel = Selection
 Länge = Länge - 2
 Tz = Mid(Formel, Länge, 1)
 If Tz = " " Then
 Selection.Characters(Länge) = ""
 End If
 Tz = Mid(Formel, 1, 1)
 If Tz = "Q" Then
 Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
 End If
End If

'Selection.MoveRight Unit:=wdCharacter, Count:=2
'Selection.EndKey Unit:=wdLine, Extend:=wdExtend
'Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

If Selection.Characters(1) = " " Then
If Selection.Characters(2) = " " Then
Selection.Characters(2) = ""
End If
End If

Formel = Selection
'\B entfernen
Länge = Len(Formel)
For aktuellZeichen = Länge - 3 To 4 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "B" Or Tz = "b" Then
Tz = Mid(Formel, aktuellZeichen - 1, 1)
If Tz = "\" Then
Selection.Characters(aktuellZeichen) = ""
Selection.Characters(aktuellZeichen - 1) = ""
End If
End If
Next

'\F umwandeln
Formel = Selection
Länge = Len(Formel)
For aktuellZeichen = Länge - 3 To 4 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "F" Or Tz = "f" Then
Tz = Mid(Formel, aktuellZeichen - 1, 1)
If Tz = "\" Then
    Formel = Selection
    Länge = Len(Formel)
    Endzeichen = aktuellZeichen + 1
    Klammersumme = 1
    While Klammersumme <> 0     'aktuellzeichen = F
    Endzeichen = Endzeichen + 1 'Endzeichen = letzte Klammer)
    Tz = Mid(Formel, Endzeichen, 1)
    Klammersumme = Klammersumme + Klammer(Tz)
    If Selection.Characters(Endzeichen) = ";" And Klammersumme = 1 Then
    Azeichen = Endzeichen 'Azeichen = ;
    End If
    Wend
    'entfernt Leerzeichen
    If Selection.Characters(Azeichen + 1) = " " Then
    Selection.Characters(Azeichen + 1) = ""
    Endzeichen = Endzeichen - 1
    Formel = Selection
    End If
    If Selection.Characters(Azeichen - 1) = " " Then
    Selection.Characters(Azeichen - 1) = ""
    Endzeichen = Endzeichen - 1
    Azeichen = Azeichen - 1
    Formel = Selection
    End If
    'bearbeitet die rechte Seite
    e = 0
    For c = Azeichen + 2 To Endzeichen
        Tz = Mid(Formel, c, 1)
        Select Case Tz 'Selection.Characters(c)
        Case "+", "-", "*", "•", "/", ChrW(8729)
        e = 0
        Exit For
        Case Else
        e = 1
        End Select
    Next
    If e = 1 Then
    Selection.Characters(Endzeichen) = ""
    Else
    Selection.Characters(Azeichen).InsertAfter ("(")
    End If
    Selection.Characters(Azeichen) = "/"
    'Bearbeitet die linke Seite
    e = 0   '+3 berücksichtigt negative Vorzeichen
    For c = aktuellZeichen + 3 To Azeichen - 1
        Tz = Mid(Formel, c, 1)
        Select Case Tz 'Selection.Characters(c)
        Case "+", "-"
        e = 1
        Exit For
        Case Else
        e = 0 ' Klammer entfernen
        End Select
    Next
    If e = 1 Then
        If Selection.Characters(aktuellZeichen + 2) = "(" Then
        e = 0
        ElseIf Selection.Characters(aktuellZeichen + 2) = "-" And Selection.Characters(aktuellZeichen + 3) = "(" Then
        e = 0
        Else
        e = 1 'Klammer hinzufügen
        End If
    End If
    If e = 1 Then
        With Selection.Characters(Azeichen)
         .InsertBefore (")")
         .Font.Superscript = False
         .Font.Superscript = False
        End With
        Else
        Selection.Characters(aktuellZeichen + 1) = ""
    End If
    Selection.Characters(aktuellZeichen) = ""
    Selection.Characters(aktuellZeichen - 1) = ""
End If
End If
Next

'\R umwandeln
Formel = Selection
Länge = Len(Formel)
For aktuellZeichen = Länge - 3 To 4 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "R" Or Tz = "r" Then
Tz = Mid(Formel, aktuellZeichen - 1, 1)
If Tz = "\" Then
    Endzeichen = aktuellZeichen + 1
    Klammersumme = 1
    While Klammersumme <> 0     'aktuellzeichen = R
    Endzeichen = Endzeichen + 1 'Endzeichen = letzte Klammer)
    Tz = Mid(Formel, Endzeichen, 1)
    Klammersumme = Klammersumme + Klammer(Tz)
    If Tz = ";" And Klammersumme = 1 Then
    Azeichen = Endzeichen 'Azeichen = ;
    End If
    Wend
    'entfernt Leerzeichen
    If Selection.Characters(Azeichen + 1) = " " Then
    Selection.Characters(Azeichen + 1) = ""
    Endzeichen = Endzeichen - 1
    Formel = Selection
    End If
    If Selection.Characters(Azeichen - 1) = " " Then
    Selection.Characters(Azeichen - 1) = ""
    Endzeichen = Endzeichen - 1
    Azeichen = Azeichen - 1
    Formel = Selection
    End If
    e = 0
    Tausch = 0
    For c = Azeichen + 1 To Endzeichen
        Tz = Mid(Formel, c, 1)
        Select Case Tz
        Case "+", "-", "*", "•", "/", ChrW(8729), ChrW(8211)
        e = 1 '1= Klammer hinzufügen
        Exit For
        Case Else
        If Selection.Characters(c).Font.Superscript = True Or Selection.Characters(c).Font.Subscript = True Then
        If Selection.Characters(aktuellZeichen).Font.Superscript = True Then
        e = 0
        Selection.Characters(Endzeichen).InsertBefore ("^")
        Endzeichen = Endzeichen + 1
        Else
        e = 1
        End If
        Exit For
        Else
        e = 0
        End If
        End Select
    Next
    If aktuellZeichen = Azeichen - 2 Then
     If e = 1 Then
' Berücksichtigt folgende Fälle
'EQ \r(;123)                ->-- 123^0,5
'EQ \r(;123+4*(234)-123)    ->00 (123+4*(234)-123)^0,5
'EQ \r(;\s\up1(4))          ->-- \s\up1(4)^0,5
'EQ \r(;-354)               ->00 (-354)^0,5
'EQ \r(;(354-34)^0,4)       ->00 ((354-34)^0,4)^0,5
'EQ \r(;(354-34)_0,4)       ->00 ((354-34)_0,4)^0,5
        With Selection
        .Characters(Endzeichen).InsertBefore (")0,5")
        .Characters(Endzeichen + 4) = ""
        .Characters(Endzeichen).Font.Superscript = False
        .Characters(Endzeichen).Font.Subscript = False
        .Characters(Endzeichen + 1).Font.Superscript = True
        .Characters(Endzeichen + 2).Font.Superscript = True
        .Characters(Endzeichen + 3).Font.Superscript = True
        .Characters(aktuellZeichen) = ""
        .Characters(aktuellZeichen + 1) = ""
        .Characters(aktuellZeichen - 1) = ""
        End With
     Else
        With Selection
        .Characters(Endzeichen).InsertBefore ("0,5")
        .Characters(Endzeichen + 3) = ""
        .Characters(Endzeichen).Font.Superscript = True
        .Characters(Endzeichen + 1).Font.Superscript = True
        .Characters(Endzeichen + 2).Font.Superscript = True
        .Characters(aktuellZeichen) = ""
        .Characters(aktuellZeichen) = ""
        .Characters(aktuellZeichen) = ""
        .Characters(aktuellZeichen - 1) = ""
        End With
     End If
    Else
        Tausch = Azeichen - aktuellZeichen - 2
        c = 0
        For d = 1 To Tausch
            If Steuerzeichen(Selection.Characters(aktuellZeichen + 1 + d)) = 1 Then
            If Klammer(Selection.Characters(aktuellZeichen + 1 + d)) = 0 Then
            c = 1 'erzeugt eine Klammer; irreversibel für RNA-Polymerase
            End If
            End If
        Next
        If c = 1 Then
            Selection.Characters(Azeichen).InsertBefore (")")
            Selection.Characters(aktuellZeichen + 1).InsertAfter ("(")
            Tausch = Tausch + 2
            Endzeichen = Endzeichen + 2
            Azeichen = Azeichen + 2
        End If
        For d = 1 To Tausch
        With Selection
        .Characters(Endzeichen).InsertBefore (Selection.Characters(aktuellZeichen + 2))
        .Characters(Endzeichen).Font.Superscript = True
        .Characters(aktuellZeichen + 2) = ""
        End With
        Next
        Selection.Characters(Endzeichen) = ""
        If e = 1 Then
        With Selection
        .Characters(Endzeichen - Tausch) = "1/" & Selection.Characters(Endzeichen - Tausch)
        .Characters(Endzeichen - Tausch - 1).InsertAfter (")")
        .Characters(Endzeichen - Tausch).Font.Superscript = False
        .Characters(Endzeichen - Tausch).Font.Subscript = False
        .Characters(aktuellZeichen) = ""
        .Characters(aktuellZeichen + 1) = ""
        .Characters(aktuellZeichen - 1) = ""
        End With
        Else
        With Selection
        .Characters(Endzeichen - Tausch).InsertBefore "1/" '& Selection.Characters(Endzeichen - Tausch)
        .Characters(Endzeichen - Tausch).Font.Superscript = True
        .Characters(Endzeichen - Tausch + 1).Font.Superscript = True
        .Characters(aktuellZeichen) = ""
        .Characters(aktuellZeichen) = ""
        .Characters(aktuellZeichen) = ""
        .Characters(aktuellZeichen - 1) = ""
        End With
        End If
    End If
End If
End If
Next

For c = 1 To 3 'ganz zum schluss
If Selection.Characters(c) = "E" Or Selection.Characters(c) = "e" Then
If Selection.Characters(c + 1) = "Q" Or Selection.Characters(c + 1) = "q" Then
If Selection.Characters(c + 2) = " " Then
    If c = 1 Then
    Länge = Len(Selection) - 3
    End If
    Selection.Characters(c + 2).Delete
    Selection.Characters(c + 1).Delete
    Selection.Characters(c).Delete
    If Len(Selection) = 1 Then
    Selection.MoveRight Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend
    End If
    Exit For
End If
End If
End If
Next

End Function

Function Ribosom() As Integer
'EQ zu Wikipedia
Dim Länge, aktuellZeichen, Klammersumme, Tausch As Integer
Dim c, d, e, Endzeichen, Azeichen As Integer
Dim Zeichen, Formel, Tz, Schriftart, Schriftart2 As String

Ribosom = 1

c = DNAse()
Formel = Selection
Länge = Len(Formel) '
 Tz = Mid(Formel, Länge, 1) & "</math>" '

Selection.Characters(Länge).InsertBefore (Tz)
Selection.Characters(Länge + 8) = ""
Tz = Mid(Formel, 1, 1)
If Tz = " " Then '
     Selection.Characters(1) = ":<math>"
     d = 1
     Tz = Mid(Formel, 2, 1)
     Else
     Selection.Characters(1).InsertBefore (":<math>")
     d = 0 '
End If
Länge = Länge - d + 14
If Len(Selection) = 1 Then
 Selection.MoveRight Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend
End If
If Tz = "e" Or Tz = "E" Then
 Selection.Characters(8) = ""
 Selection.Characters(8) = ""
 Else
 Tz = Mid(Formel, 3, 1)
 If Tz = "e" Or Tz = "E" Then
 Selection.Characters(9) = ""
 Selection.Characters(9) = ""
 End If
End If

'große Klammern
Formel = Selection
Länge = Len(Formel)
For aktuellZeichen = Länge - 7 To 8 Step -1
Tz = Mid(Formel, aktuellZeichen, 3)
If Tz = "\b(" Or Tz = "\B(" Then
    Klammersumme = 1
    Endzeichen = aktuellZeichen + 3
    While Klammersumme <> 0
    Tz = Mid(Formel, Endzeichen, 1)
    Klammersumme = Klammersumme + Klammer(Tz)
    Endzeichen = Endzeichen + 1
    Wend
    Selection.Characters(Endzeichen - 1).InsertBefore ("\right")
    Selection.Characters(aktuellZeichen + 1) = "left"
    Formel = Selection
End If
Next

'Brüche
Länge = Len(Formel)
For aktuellZeichen = Länge - 7 To 8 Step -1
Tz = Mid(Formel, aktuellZeichen, 3)
If Tz = "\f(" Or Tz = "\F(" Then
    Klammersumme = 1
    Endzeichen = aktuellZeichen + 3
    While Klammersumme <> 0
    Tz = Mid(Formel, Endzeichen, 1)
    Klammersumme = Klammersumme + Klammer(Tz)
    If Tz = ";" And Klammersumme = 1 Then
    Azeichen = Endzeichen
    End If
    Endzeichen = Endzeichen + 1
    Wend
    'aktuellZeichen= \  Azeichen= ;  Endzeichen-1 =)
    Selection.Characters(Endzeichen - 1) = "}"
    Selection.Characters(Azeichen) = "}{"
    Selection.Characters(aktuellZeichen + 2) = "frac{"
    Selection.Characters(aktuellZeichen + 1) = ""
    Formel = Selection
End If
Next

'Wurzeln
Länge = Len(Formel)
For aktuellZeichen = Länge - 7 To 8 Step -1
Tz = Mid(Formel, aktuellZeichen, 3)
If Tz = "\r(" Or Tz = "\R(" Then
    Klammersumme = 1
    Endzeichen = aktuellZeichen + 3
    While Klammersumme <> 0
    Tz = Mid(Formel, Endzeichen, 1)
    Klammersumme = Klammersumme + Klammer(Tz)
    If Tz = ";" And Klammersumme = 1 Then
    Azeichen = Endzeichen
    End If
    Endzeichen = Endzeichen + 1
    Wend
    'aktuellZeichen= \  Azeichen= ;  Endzeichen-1 =)
    If Azeichen = aktuellZeichen + 3 Then
     Selection.Characters(Endzeichen - 1) = "}"
     Selection.Characters(aktuellZeichen + 3) = ""
     Selection.Characters(aktuellZeichen + 1) = "s"
     Selection.Characters(aktuellZeichen + 2) = "qrt{"
    Else
     Selection.Characters(Endzeichen - 1) = "}"
     Selection.Characters(Azeichen) = "]{"
     Selection.Characters(aktuellZeichen + 1) = "s"
     Selection.Characters(aktuellZeichen + 2) = "qrt["
    End If
    Formel = Selection
End If
Next

'Sonderzeichen Unicode
Länge = Len(Formel)
For aktuellZeichen = Länge - 7 To 8 Step -1
    Tz = Mid(Formel, aktuellZeichen, 1)
    Select Case AscW(Tz)
    Case 42
    Selection.Characters(aktuellZeichen) = "\cdot "
    Case 44
    Selection.Characters(aktuellZeichen) = "{,}"
    Case 183
    Selection.Characters(aktuellZeichen) = "\cdot "
    Case 186
    Selection.Characters(aktuellZeichen) = "^\circ "
    Case 196
    Selection.Characters(aktuellZeichen) = "\ddot{A}"
    Case 214
    Selection.Characters(aktuellZeichen) = "\ddot{O}"
    Case 216
    Selection.Characters(aktuellZeichen) = "\varnothing "
    Case 220
    Selection.Characters(aktuellZeichen) = "\ddot{U}"
    Case 228
    Selection.Characters(aktuellZeichen) = "\ddot{a}"
    Case 246
    Selection.Characters(aktuellZeichen) = "\ddot{o}"
    Case 248
    Selection.Characters(aktuellZeichen) = "\varnothing "
    Case 252
    Selection.Characters(aktuellZeichen) = "\ddot{u}"
    Case 913
    Selection.Characters(aktuellZeichen) = "\Alpha "
    Case 914
    Selection.Characters(aktuellZeichen) = "\Beta "
    Case 915
    Selection.Characters(aktuellZeichen) = "\Gamma "
    Case 916
    Selection.Characters(aktuellZeichen) = "\Delta "
    Case 917
    Selection.Characters(aktuellZeichen) = "\Epsilon "
    Case 918
    Selection.Characters(aktuellZeichen) = "\Zeta "
    Case 919
    Selection.Characters(aktuellZeichen) = "\Eta "
    Case 920
    Selection.Characters(aktuellZeichen) = "\Theta "
    Case 921
    Selection.Characters(aktuellZeichen) = "\Iota "
    Case 922
    Selection.Characters(aktuellZeichen) = "\Kappa "
    Case 923
    Selection.Characters(aktuellZeichen) = "\Lambda "
    Case 924
    Selection.Characters(aktuellZeichen) = "\Mu "
    Case 925
    Selection.Characters(aktuellZeichen) = "\Nu "
    Case 926
    Selection.Characters(aktuellZeichen) = "\Omicron "
    Case 927
    Selection.Characters(aktuellZeichen) = "\Xi "
    Case 928
    Selection.Characters(aktuellZeichen) = "\Pi "
    Case 929
    Selection.Characters(aktuellZeichen) = "\Rho "
    Case 931
    Selection.Characters(aktuellZeichen) = "\Sigma "
    Case 932
    Selection.Characters(aktuellZeichen) = "\Tau "
    Case 933
    Selection.Characters(aktuellZeichen) = "\Upsilon "
    Case 934
    Selection.Characters(aktuellZeichen) = "\Phi "
    Case 935
    Selection.Characters(aktuellZeichen) = "\Chi "
    Case 936
    Selection.Characters(aktuellZeichen) = "\Psi "
    Case 937
    Selection.Characters(aktuellZeichen) = "\Omega "
    
    Case 945
    Selection.Characters(aktuellZeichen) = "\alpha "
    Case 946
    Selection.Characters(aktuellZeichen) = "\beta "
    Case 947
    Selection.Characters(aktuellZeichen) = "\gamma "
    Case 948
    Selection.Characters(aktuellZeichen) = "\delta "
    Case 949
    Selection.Characters(aktuellZeichen) = "\epsilon "
    Case 950
    Selection.Characters(aktuellZeichen) = "\zeta "
    Case 951
    Selection.Characters(aktuellZeichen) = "\eta "
    Case 952
    Selection.Characters(aktuellZeichen) = "\theta "
    Case 953
    Selection.Characters(aktuellZeichen) = "\iota "
    Case 954
    Selection.Characters(aktuellZeichen) = "\kappa "
    Case 955
    Selection.Characters(aktuellZeichen) = "\lambda "
    Case 956
    Selection.Characters(aktuellZeichen) = "\mu "
    Case 957
    Selection.Characters(aktuellZeichen) = "\nu "
    Case 958
    Selection.Characters(aktuellZeichen) = "\xi "
    Case 959
    Selection.Characters(aktuellZeichen) = "\omicron "
    Case 960
    Selection.Characters(aktuellZeichen) = "\pi "
    Case 961
    Selection.Characters(aktuellZeichen) = "\rho "
    Case 962
    Selection.Characters(aktuellZeichen) = "\varsigma "
    Case 963
    Selection.Characters(aktuellZeichen) = "\sigma "
    Case 964
    Selection.Characters(aktuellZeichen) = "\tau "
    Case 965
    Selection.Characters(aktuellZeichen) = "\upsilon "
    Case 966
    Selection.Characters(aktuellZeichen) = "\phi "
    Case 967
    Selection.Characters(aktuellZeichen) = "\chi "
    Case 968
    Selection.Characters(aktuellZeichen) = "\Psi "
    Case 969
    Selection.Characters(aktuellZeichen) = "\omega "
    
    Case 8729
    Selection.Characters(aktuellZeichen) = "\cdot "
    Case 8734
    Selection.Characters(aktuellZeichen) = "\infty "
    Case 8776
    Selection.Characters(aktuellZeichen) = "\approx "
    'Case 8800
    'Selection.Characters(aktuellZeichen) = "\ungleich "
    Case 8804
    Selection.Characters(aktuellZeichen) = "\le "
    Case 8805
    Selection.Characters(aktuellZeichen) = "\ge "
    
    End Select
Next

'Schriftart Symbol
Schriftart = Selection.Font.Name
Formel = Selection
Länge = Len(Formel)
d = 0
If Schriftart = "" Then
    d = 1
    Schriftart = Selection.Characters(Länge).Font.Name
    If Schriftart = "Symbol" Then
    Schriftart = Selection.Characters(1).Font.Name
     If Schriftart = "Symbol" Then
      For c = 2 To Länge - 1
      Schriftart = Selection.Characters(c).Font.Name
      If Schriftart <> "Symbol" Then Exit For
      Next
     End If
    End If
End If
If d = 1 Or Schriftart = "Symbol" Then 'verhindert Bremse
For aktuellZeichen = Länge To 1 Step -1
If Selection.Characters(aktuellZeichen).Font.Name = "Symbol" Then
    Tz = Mid(Formel, aktuellZeichen, 1)
    e = AscW(Tz)
    e = e Mod 256
    If e < 0 Then e = e + 256
    If e < 64 Then
    Selection.Characters(aktuellZeichen) = Chr(e)
    End If
    Selection.Characters(aktuellZeichen).Font.Name = Schriftart
    Select Case e
    Case 65
    Selection.Characters(aktuellZeichen) = "\Alpha "
    Case 66
    Selection.Characters(aktuellZeichen) = "\Beta "
    Case 67
    Selection.Characters(aktuellZeichen) = "\Chi "
    Case 68
    Selection.Characters(aktuellZeichen) = "\Delta "
    Case 69
    Selection.Characters(aktuellZeichen) = "\Epsilon "
    Case 70
    Selection.Characters(aktuellZeichen) = "\Phi "
    Case 71
    Selection.Characters(aktuellZeichen) = "\Gamma "
    Case 72
    Selection.Characters(aktuellZeichen) = "\Eta "
    Case 73
    Selection.Characters(aktuellZeichen) = "\Iota "
    Case 74
    Selection.Characters(aktuellZeichen) = "\vartheta "
    Case 75
    Selection.Characters(aktuellZeichen) = "\Kappa "
    Case 76
    Selection.Characters(aktuellZeichen) = "\Lambda "
    Case 77
    Selection.Characters(aktuellZeichen) = "\Mu "
    Case 78
    Selection.Characters(aktuellZeichen) = "\Nu "
    Case 79
    Selection.Characters(aktuellZeichen) = "\Omicron "
    Case 80
    Selection.Characters(aktuellZeichen) = "\Pi "
    Case 81
    Selection.Characters(aktuellZeichen) = "\Theta "
    Case 82
    Selection.Characters(aktuellZeichen) = "\Rho "
    Case 83
    Selection.Characters(aktuellZeichen) = "\Sigma "
    Case 84
    Selection.Characters(aktuellZeichen) = "\Tau "
    Case 85
    Selection.Characters(aktuellZeichen) = "\Upsilon "
    Case 86
    Selection.Characters(aktuellZeichen) = "\varsigma "
    Case 87
    Selection.Characters(aktuellZeichen) = "\Omega "
    Case 88
    Selection.Characters(aktuellZeichen) = "\Xi "
    Case 89
    Selection.Characters(aktuellZeichen) = "\Psi "
    Case 90
    Selection.Characters(aktuellZeichen) = "\Zeta "
    
    Case 97
    Selection.Characters(aktuellZeichen) = "\alpha "
    Case 98
    Selection.Characters(aktuellZeichen) = "\beta "
    Case 99
    Selection.Characters(aktuellZeichen) = "\chi "
    Case 100
    Selection.Characters(aktuellZeichen) = "\delta "
    Case 101
    Selection.Characters(aktuellZeichen) = "\epsilon "
    Case 102
    Selection.Characters(aktuellZeichen) = "\phi "
    Case 103
    Selection.Characters(aktuellZeichen) = "\gamma "
    Case 104
    Selection.Characters(aktuellZeichen) = "\eta "
    Case 105
    Selection.Characters(aktuellZeichen) = "\iota "
    Case 106
    Selection.Characters(aktuellZeichen) = "\kappa "
    Case 107
    Selection.Characters(aktuellZeichen) = "\lambda "
    Case 108
    Selection.Characters(aktuellZeichen) = "\mu "
    Case 109
    Selection.Characters(aktuellZeichen) = "\nu "
    Case 110
    Selection.Characters(aktuellZeichen) = "\omicron "
    Case 111
    Selection.Characters(aktuellZeichen) = "\pi "
    Case 112
    Selection.Characters(aktuellZeichen) = "\theta "
    Case 113
    Selection.Characters(aktuellZeichen) = "\rho "
    Case 114
    Selection.Characters(aktuellZeichen) = "\sigma "
    Case 115
    Selection.Characters(aktuellZeichen) = "\tau "
    Case 116
    Selection.Characters(aktuellZeichen) = "\upsilon "
    Case 117
    Selection.Characters(aktuellZeichen) = "\varpi "
    Case 118
    Selection.Characters(aktuellZeichen) = "\omega "
    Case 119
    Selection.Characters(aktuellZeichen) = "\xi "
    Case 120
    Selection.Characters(aktuellZeichen) = "\psi "
    Case 121
    Selection.Characters(aktuellZeichen) = "\zeta "
    
    Case 163
    Selection.Characters(aktuellZeichen) = "\le "
    Case 165
    Selection.Characters(aktuellZeichen) = "\infty "
    Case 176
    Selection.Characters(aktuellZeichen) = "^\circ "
    Case 177
    Selection.Characters(aktuellZeichen) = "\pm "
    Case 179
    Selection.Characters(aktuellZeichen) = "\ge "
    'Case 185
    'Selection.Characters(aktuellZeichen) = "ungleich "
    Case 187
    Selection.Characters(aktuellZeichen) = "\approx "
    Case 198
    Selection.Characters(aktuellZeichen) = "\varnothing "
    Case 213
    Selection.Characters(aktuellZeichen) = "\Pi "
    Case 229
    Selection.Characters(aktuellZeichen) = "\Sigma "
    End Select
End If
Next
End If

'bearbeitet Lambdaquer
Formel = Selection
Länge = Len(Formel)

For aktuellZeichen = Länge - 20 To 8 Step -1
    Tz = Mid(Formel, aktuellZeichen, 3)
    If Tz = "\o(" Then
    c = 0
    Tz = Mid(Formel, aktuellZeichen + 3, 11)
    If Tz = "\lambda ;¯)" Or Tz = "¯;\lambda )" Then c = 1: d = 0
    Tz = Mid(Formel, aktuellZeichen + 3, 19)
    If Tz = "\lambda ;\s\up1(¯))" Or Tz = "\s\up1(¯);\lambda )" Then c = 1: d = 1
     If c = 1 Then
     With Selection
        .Characters(aktuellZeichen + 2) = "v"
        .Characters(aktuellZeichen + 3) = "e"
        .Characters(aktuellZeichen + 4) = "r"
        .Characters(aktuellZeichen + 5) = "l"
        .Characters(aktuellZeichen + 6) = "i"
        .Characters(aktuellZeichen + 7) = "n"
        .Characters(aktuellZeichen + 8) = "e"
        .Characters(aktuellZeichen + 9) = "{"
        .Characters(aktuellZeichen + 10) = "\"
        .Characters(aktuellZeichen + 11) = "l"
        .Characters(aktuellZeichen + 12) = "a"
     End With
     If d = 0 Then
     Selection.Characters(aktuellZeichen + 13) = "mbda }"
     Else
     With Selection
        .Characters(aktuellZeichen + 13) = "m"
        .Characters(aktuellZeichen + 14) = "b"
        .Characters(aktuellZeichen + 15) = "d"
        .Characters(aktuellZeichen + 16) = "a"
        .Characters(aktuellZeichen + 17) = " "
        .Characters(aktuellZeichen + 18) = "}"
        .Characters(aktuellZeichen + 19) = ""
        .Characters(aktuellZeichen + 19) = ""
        .Characters(aktuellZeichen + 19) = ""
     End With
     End If
     End If
    End If
Next

End Function

Function Reversetranslatase(ByVal Hemmung As Integer) As Integer
'Wikipedia zu EQ
Dim Länge, aktuellZeichen, Klammersumme, Tausch As Integer
Dim c, d, e, Endzeichen, Verkürzung, Azeichen As Integer
Dim Zeichen, Formel, Tz, Tt, Symbol, Schriftart, Schriftart2 As String

Reversetranslatase = 1

Formel = Selection
Länge = Len(Formel)

For aktuellZeichen = Länge - 9 To 7 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "\" Then
    c = 1
    Endzeichen = 1
    While c = 1
        Tt = Mid(Formel, aktuellZeichen + Endzeichen, 1)
        If Tt <> "" Then
        d = Asc(Tt)
        Else
        d = 63
        End If
        If (d > 64 And d < 91) Or (d > 96 And d < 123) Then
        c = 1
        Endzeichen = Endzeichen + 1
        ElseIf d = 123 Then
        Endzeichen = Endzeichen + 3
        c = 0
        Else
        c = 0
        End If
    Wend
    Tt = Mid(Formel, aktuellZeichen + 1, Endzeichen - 1)
    e = 1
    Select Case Tt
    Case "cdot"
    Symbol = ChrW(183)
    Case "circ"
    Symbol = ChrW(186)
    aktuellZeichen = aktuellZeichen - 1
    Case "ddot{A}"
    Symbol = ChrW(196)
    Case "ddot{O}"
    Symbol = ChrW(214)
    Case "ddot{U}"
    Symbol = ChrW(220)
    Case "ddot{a}"
    Symbol = ChrW(228)
    Case "ddot{o}"
    Symbol = ChrW(246)
    Case "varnothing"
    Symbol = ChrW(248)
    Case "ddot{u}"
    Symbol = ChrW(252)
    Case "Alpha"
    Symbol = ChrW(913)
    Case "Beta"
    Symbol = ChrW(914)
    Case "Gamma"
    Symbol = ChrW(915)
    Case "Delta"
    Symbol = ChrW(916)
    Case "Epsilon"
    Symbol = ChrW(917)
    Case "Zeta"
    Symbol = ChrW(918)
    Case "Eta"
    Symbol = ChrW(919)
    Case "Theta"
    Symbol = ChrW(920)
    Case "Iota"
    Symbol = ChrW(921)
    Case "Kappa"
    Symbol = ChrW(922)
    Case "Lambda"
    Symbol = ChrW(923)
    Case "Mu"
    Symbol = ChrW(924)
    Case "Nu"
    Symbol = ChrW(925)
    Case "Omicron"
    Symbol = ChrW(926)
    Case "Xi"
    Symbol = ChrW(927)
    Case "Pi"
    Symbol = ChrW(928)
    Case "Rho"
    Symbol = ChrW(929)
    Case "Sigma"
    Symbol = ChrW(931)
    Case "Tau"
    Symbol = ChrW(932)
    Case "Upsilon"
    Symbol = ChrW(933)
    Case "Phi"
    Symbol = ChrW(934)
    Case "Chi"
    Symbol = ChrW(935)
    Case "Psi"
    Symbol = ChrW(936)
    Case "Omega"
    Symbol = ChrW(937)
    
    Case "alpha"
    Symbol = ChrW(945)
    Case "beta"
    Symbol = ChrW(946)
    Case "gamma"
    Symbol = ChrW(947)
    Case "delta"
    Symbol = ChrW(948)
    Case "epsilon"
    Symbol = ChrW(949)
    Case "zeta"
    Symbol = ChrW(950)
    Case "eta"
    Symbol = ChrW(951)
    Case "theta"
    Symbol = ChrW(952)
    Case "iota"
    Symbol = ChrW(953)
    Case "kappa"
    Symbol = ChrW(954)
    Case "lambda"
    Symbol = ChrW(955)
    Case "mu"
    Symbol = ChrW(956)
    Case "nu"
    Symbol = ChrW(957)
    Case "xi"
    Symbol = ChrW(958)
    Case "omicron"
    Symbol = ChrW(959)
    Case "pi"
    Symbol = ChrW(960)
    Case "rho"
    Symbol = ChrW(961)
    Case "varsigma"
    Symbol = ChrW(962)
    Case "sigma"
    Symbol = ChrW(963)
    Case "tau"
    Symbol = ChrW(964)
    Case "upsilon"
    Symbol = ChrW(965)
    Case "phi"
    Symbol = ChrW(966)
    Case "chi"
    Symbol = ChrW(967)
    Case "Psi"
    Symbol = ChrW(968)
    Case "omega"
    Symbol = ChrW(969)
    
    Case "infty"
    Symbol = ChrW(8734)
    Case "approx"
    Symbol = ChrW(8776)
    Case "ungleich"
    Symbol = ChrW(8800)
    Case "le"
    Symbol = ChrW(8804)
    Case "ge"
    Symbol = ChrW(8805)
    Case Else
    e = 0
    End Select
    If e = 1 Then
     If d = 32 Then
     Formel = Mid(Formel, 1, aktuellZeichen - 1) & Symbol & Mid(Formel, aktuellZeichen + Endzeichen + 1)
     Else
     Formel = Mid(Formel, 1, aktuellZeichen - 1) & Symbol & Mid(Formel, aktuellZeichen + Endzeichen)
     End If
    End If
End If
Next

'Komma
Länge = Len(Formel)
For aktuellZeichen = Länge - 9 To 7 Step -1
Tz = Mid(Formel, aktuellZeichen, 3)
If Tz = "{,}" Then
Formel = Mid(Formel, 1, aktuellZeichen - 1) & "," & Mid(Formel, aktuellZeichen + 3)
End If
Next

'overline
Länge = Len(Formel)
For aktuellZeichen = Länge - 17 To 7 Step -1 '77
Tz = Mid(Formel, aktuellZeichen, 10)
If Tz = "\overline{" Then
 Tt = Mid(Formel, aktuellZeichen + 11, 1)
 If Tt = "}" Then
 Mid(Formel, aktuellZeichen + 2, 8) = "(\s\up1("
 Mid(Formel, aktuellZeichen + 11, 1) = ")"
 Formel = Mid(Formel, 1, aktuellZeichen + 9) & "¯);" & Mid(Formel, aktuellZeichen + 10)
 End If
End If
Next

'bearbeitet Wurzeln
Länge = Len(Formel)
For aktuellZeichen = Länge - 14 To 7 Step -1
Tz = Mid(Formel, aktuellZeichen, 5)
If Tz = "\sqrt" Then
    Formel = Mid(Formel, 1, aktuellZeichen) & "r(" & Mid(Formel, aktuellZeichen + 5)
    Endzeichen = aktuellZeichen + 3
    Tz = Mid(Formel, Endzeichen, 1)
    If Tz = "[" Then
     Formel = Mid(Formel, 1, Endzeichen - 1) & Mid(Formel, Endzeichen + 1)
     While Tz <> "]"
     Endzeichen = Endzeichen + 1
     Tz = Mid(Formel, Endzeichen, 1)
     If Tz = "" Then Tz = "]"
     Wend
     Formel = Mid(Formel, 1, Endzeichen - 1) & Mid(Formel, Endzeichen + 1)
     Tz = Mid(Formel, Endzeichen, 1)
    End If
    If Tz = "{" Then
     Mid(Formel, Endzeichen, 1) = ";"
     Klammersumme = 1
     While Klammersumme > 0
     Endzeichen = Endzeichen + 1
     Tz = Mid(Formel, Endzeichen, 1)
     Klammersumme = Klammersumme + Klammer2(Tz)
     Wend
     Mid(Formel, Endzeichen, 1) = ")"
    End If
End If
Next

'Brüche
Länge = Len(Formel)
For aktuellZeichen = Länge - 17 To 7 Step -1
Tz = Mid(Formel, aktuellZeichen, 5)
If Tz = "\frac" Then
    Mid(Formel, aktuellZeichen + 5, 1) = "("
    Formel = Mid(Formel, 1, aktuellZeichen + 1) & Mid(Formel, aktuellZeichen + 5)
    Klammersumme = 1
    Endzeichen = aktuellZeichen + 2
    While Klammersumme > 0
    Endzeichen = Endzeichen + 1
    Klammersumme = Klammersumme + Klammer2(Mid(Formel, Endzeichen, 1))
    Wend
    Formel = Mid(Formel, 1, Endzeichen - 1) & ";" & Mid(Formel, Endzeichen + 2)
    Klammersumme = 1
    While Klammersumme > 0
    Endzeichen = Endzeichen + 1
    Klammersumme = Klammersumme + Klammer2(Mid(Formel, Endzeichen, 1))
    Wend
    Mid(Formel, Endzeichen, 1) = ")"
End If
Next

'große Klammern
Länge = Len(Formel)
For aktuellZeichen = Länge - 13 To 7 Step -1
Tz = Mid(Formel, aktuellZeichen, 6)
If Tz = "\right" Then
    Formel = Mid(Formel, 1, aktuellZeichen - 1) & Mid(Formel, aktuellZeichen + 6)
End If
If Tz = "\left(" Then
    Formel = Mid(Formel, 1, aktuellZeichen - 1) & "\b" & Mid(Formel, aktuellZeichen + 5)
End If
Next

'^2 ^3
Länge = Len(Formel)
For aktuellZeichen = Länge - 8 To 8 Step -1
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "^" Then
 Tz = Mid(Formel, aktuellZeichen + 1, 1)
 If Tz = "2" Then
    Formel = Mid(Formel, 1, aktuellZeichen - 1) & "²" & Mid(Formel, aktuellZeichen + 2)
 ElseIf Tz = "3" Then
    Formel = Mid(Formel, 1, aktuellZeichen - 1) & "³" & Mid(Formel, aktuellZeichen + 2)
 End If
End If
Next

Länge = Len(Formel)
Formel = "EQ " & Mid(Formel, 9, Länge - 15)
Länge = Länge - 12
Selection.TypeText Formel
Selection.MoveLeft Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend

'stellt hochtief von DNApolymerase mit {} statt ()
aktuellZeichen = 1
For aktuellZeichen = Länge To 5 Step -1
Verkürzung = 0
Tz = Mid(Formel, aktuellZeichen, 1)
If Tz = "^" Then
    d = 1
    ElseIf Tz = "_" Then
    d = -1
    Else
    d = 0
End If
If d <> 0 Then
    Tz = Mid(Formel, aktuellZeichen + 1, 1)
    If Tz = " " Then
    Selection.Characters(aktuellZeichen + 1) = ""
    Formel = Selection
    Tz = Mid(Formel, aktuellZeichen + 1, 1)
    End If
    Selection.Characters(aktuellZeichen) = "" '+1 im string
    If Tz = "{" Then
    Klammersumme = 1
    Selection.Characters(aktuellZeichen) = ""
    While Klammersumme > 0
        If d = 1 Then
            Selection.Characters(aktuellZeichen).Font.Superscript = True
            ElseIf d = -1 Then
            Selection.Characters(aktuellZeichen).Font.Subscript = True
        End If
        aktuellZeichen = aktuellZeichen + 1
        Verkürzung = Verkürzung + 1
        Tz = Mid(Formel, aktuellZeichen + 2, 1)
        Klammersumme = Klammersumme + Klammer2(Tz)
        If Tz = "^" Then
        Selection.Characters(aktuellZeichen).InsertBefore Tz
        d = 0
        ElseIf Tz = "_" Then
        Selection.Characters(aktuellZeichen).InsertBefore Tz
        d = 0
        End If
    Wend
    Selection.Characters(aktuellZeichen) = ""
    aktuellZeichen = aktuellZeichen - Verkürzung
    Else 'Tz <> "{"
    Tz = Mid(Formel, aktuellZeichen + 1, 1)
    c = Steuerzeichen(Tz)
    While c = 0
        If d = 1 Then
            Selection.Characters(aktuellZeichen).Font.Superscript = True
            Else
            Selection.Characters(aktuellZeichen).Font.Subscript = True
        End If
        aktuellZeichen = aktuellZeichen + 1
        Verkürzung = Verkürzung + 1
        Tz = Mid(Formel, aktuellZeichen + 1, 1)
        c = Steuerzeichen(Tz)
        If Tz = "" Or Tz = ";" Then
        c = 1
        End If
    Wend
    aktuellZeichen = aktuellZeichen - Verkürzung
    End If
End If
Next

If Hemmung = 1 Then
Else
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.Fields.Update
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End If

End Function

Sub Formelwürfel()
Dim a, b, c, d, e, durch, Steuer As Integer
Dim Klammersumme, Zusatzlänge, Länge, aktuellZeichen As Integer
Dim X, Y, Formel, Tz As String
Dim Ort(3), Position(255) As Integer

Application.ScreenUpdating = False

For d = 1 To 20 'Anzahl der Formeln

Selection.TypeText ("2")
Zusatzlänge = 0
durch = 0
c = 200 'Komplexitzität der Formel
Klammersumme = 0
For b = 1 To c
a = Int((122 - 32 + 1) * Rnd + 32)
X = Chr(a)
If Steuer = 0 Then
    For e = 1 To 4
    If Steuerzeichen(X) = 0 Then
    a = Int((122 - 32 + 1) * Rnd + 32)
    X = Chr(a)
    End If
    If X = "!" Or X = "§" Or X = "%" Then
    Exit For
    End If
    If X = "+" Or X = "j" Or X = "#" Or X = "&" Or X = "$" Then
    X = "/"
    Exit For
    End If
    Next
Else
    If a < 60 Then
    a = a + 20
    X = Chr(a)
    Steuer = 0
    End If
End If
If a = 41 And Klammersumme = 0 Then
a = 40
End If
If a > 65 And a < 122 Then
If Int(4 * Rnd) = 3 Then
a = a + 848
End If
End If
X = ChrW(a)
If b = 1 And (X = "^" Or X = "_") Then
X = "1"
End If
If X = "(" Then
Klammersumme = Klammersumme + 1
ElseIf X = ")" Then
Klammersumme = Klammersumme - 1
End If
If X = "!" Or X = "§" Or X = "%" Or X = "." Or X = "@" Then
    If Klammersumme > 0 Then
    X = Chr(Int((122 - 98) * Rnd + 97)) & ")^0,5+"
    Zusatzlänge = Zusatzlänge + 6
    Klammersumme = Klammersumme - 1
    Else
    X = "^0,5-"
    Zusatzlänge = Zusatzlänge + 4
    End If
ElseIf X = ":" Or X = ";" Then
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    If Steuerzeichen(Selection.Characters(1)) = 0 Then
    X = "^(1/" & Chr(Int((122 - 98) * Rnd + 97)) & ")"
    Zusatzlänge = Zusatzlänge + 5
    Else
    X = "*"
    End If
    Selection.MoveRight Unit:=wdCharacter, Count:=1
ElseIf X = "\" Then
X = "+"
ElseIf X = "j" Or X = "#" Or X = "&" Or X = "$" Then
X = "/"
ElseIf X = "=" Then
    If Klammersumme = 0 Then
    X = "("
    Klammersumme = Klammersumme + 1
    Else
    X = ")"
    Klammersumme = Klammersumme - 1
    End If
End If
If X = "/" Or X = "*" Then
    If durch = 1 Then
    X = "-"
    End If
    If X = "/" And durch = 0 Then
    durch = 1
    End If
End If
If X = "+" Or X = "-" Then
durch = 0
End If

If b = c Then
If X = "^" Or X = "_" Then
X = "j"
End If
End If

If X = "/" Then
X = Chr(Int((122 - 98) * Rnd + 97)) & X & Chr(Int((122 - 98) * Rnd + 97))
Zusatzlänge = Zusatzlänge + 2
End If

Selection.TypeText (X)
X = Left(X, 1)
Steuer = Steuerzeichen(X)
Next

If Klammersumme > 0 Then
For b = 1 To Klammersumme
Selection.TypeText (")")
Next
End If

Selection.MoveLeft Unit:=wdCharacter, Count:=c + Zusatzlänge + Klammersumme + 1, Extend:=wdExtend

'Selection.Copy
'Länge = Len(Selection)
'Selection.MoveDown Unit:=wdLine, Count:=1
'Selection.Paste
'Selection.MoveLeft Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend

a = DNApolymerase()
a = RNApolymerase(1)

'Selection.Copy
'Länge = Len(Selection)
'Selection.MoveDown Unit:=wdLine, Count:=1
'Selection.Paste
'Selection.MoveLeft Unit:=wdCharacter, Count:=Länge, Extend:=wdExtend


'baut große Objekte herum
For c = 1 To 5 'Anzahl der großen Objekte
 Formel = Selection
 Länge = Len(Formel)
 X = ""
 Klammersumme = 0
 aktuellZeichen = 3
 e = 0
 While aktuellZeichen < Länge
    aktuellZeichen = aktuellZeichen + 1
    Tz = Mid(Formel, aktuellZeichen, 1)
    If Tz = "\" Then
     aktuellZeichen = aktuellZeichen + 2
     Tz = Mid(Formel, aktuellZeichen, 1)
    End If
    If Tz = "(" Then
        Klammersumme = 1
        aktuellZeichen = aktuellZeichen + 1
        Tz = Mid(Formel, aktuellZeichen, 1)
        While Klammersumme > 0
            Klammersumme = Klammersumme + Klammer(Tz)
            aktuellZeichen = aktuellZeichen + 1
            Tz = Mid(Formel, aktuellZeichen, 1)
            If Tz = "(" And Klammersumme = 0 Then
             Klammersumme = 1
             aktuellZeichen = aktuellZeichen + 1
             Tz = Mid(Formel, aktuellZeichen, 1)
             'e = e + 1
             'Position(e) = aktuellZeichen
             'X = X & Tz
            End If
            If Tz = "\" And Klammersumme = 0 Then
             Klammersumme = 1
             aktuellZeichen = aktuellZeichen + 3
             Tz = Mid(Formel, aktuellZeichen, 1)
             'e = e + 1
             'Position(e) = aktuellZeichen
             'X = X & Tz
            End If
        Wend
    End If
    e = e + 1
    Position(e) = aktuellZeichen
    X = X & Tz
 Wend
 e = Len(X)

 a = Int(Rnd() * 4 + 1)
 If c = 1 Then a = 4
 Ort(1) = Int(Rnd() * (e + 1) + 1)
 Ort(2) = Int(Rnd() * (e + 1) + 1)
 If Ort(1) = Ort(2) Then Ort(2) = Ort(1) + 1
    If Ort(2) < Ort(1) Then
     Ort(0) = Ort(1) ' Ort 1 ist kleiner
     Ort(1) = Ort(2)
     Ort(2) = Ort(0)
    End If
 If Ort(2) > e Then
  Position(Ort(2)) = Länge
  Ort(1) = Ort(1) - 1
  If Ort(1) = 0 Then Ort(1) = 1
 End If
 If Ort(2) - Ort(1) = 1 Then
    If Position(Ort(2)) - Position(Ort(1)) = 1 Then
    If Ort(1) > 2 Then Ort(1) = Ort(1) \ 2 + 1
    End If
 End If
 If a = 3 Or a = 4 Then
    Ort(3) = (Ort(2) + Ort(1)) \ 2
    If Ort(3) = Ort(1) Then a = 2
    If Ort(2) = Ort(3) Then a = 1
    If Ort(2) - e = 2 Then
        a = 1
    End If
 End If
X = X
 If a = 1 Then 'Ort 2 = Ende, Ort 1 = Anfang und Ort 3 = Mitte
 Selection.Characters(Position(Ort(2))).InsertBefore (")")
 Selection.Characters(Position(Ort(2))).Font.Color = wdColorSkyBlue
 Selection.Characters(Position(Ort(1))).InsertAfter ("\B(") 'a
 Selection.Characters(Position(Ort(1))).Font.Color = wdColorSkyBlue
 End If
 If a = 2 Then
 Selection.Characters(Position(Ort(2))).InsertBefore (")")
 Selection.Characters(Position(Ort(2))).Font.Color = wdColorSkyBlue
 Selection.Characters(Position(Ort(1))).InsertAfter ("\r(;") 'a
 Selection.Characters(Position(Ort(1))).Font.Color = wdColorSkyBlue
 End If
 If a = 3 Or a = 4 Then
 Selection.Characters(Position(Ort(2))).InsertBefore (")")
 Selection.Characters(Position(Ort(2))).Font.Color = wdColorSkyBlue
 If Selection.Characters(Position(Ort(3))) = "+" Then
 Selection.Characters(Position(Ort(3))) = ";"
 Selection.Characters(Position(Ort(3))).Font.Color = wdColorSkyBlue
 Else
 Selection.Characters(Position(Ort(3))).InsertAfter (";") 'a
 Selection.Characters(Position(Ort(3)) + 1).Font.Color = wdColorSkyBlue
 End If
 Selection.Characters(Position(Ort(1))).InsertAfter ("\F(") 'a
 Selection.Characters(Position(Ort(1)) + 1).Font.Color = wdColorSkyBlue
 End If
Next

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.Fields.Update
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend

If Selection = "Fehler" Then
d = d + 1
End If

Selection.MoveDown Unit:=wdLine, Count:=1
Selection.TypeParagraph
Selection.MoveUp Unit:=wdLine, Count:=1


Next
Application.ScreenUpdating = True

End Sub

Sub Zeicheneinkreisen()
Dim Zeichenwert, Länge, c, d, e As Integer
Dim Zeichen As String

'c = 11 Or c = 13
Zeichen = Selection
d = Asc(Zeichen)
If d = 11 Or d = 13 Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End If
Zeichen = Selection
d = Asc(Zeichen)
If d = 11 Or d = 13 Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End If

Zeichen = Selection
Länge = Len(Zeichen)
Zeichenwert = Asc(Zeichen)

c = 0
If (Zeichenwert > 48 And Zeichenwert < 58) And Länge = 1 Then
Zeichenwert = Zeichenwert + 9263
c = 1
End If
If (Zeichenwert > 64 And Zeichenwert < 91) And Länge = 1 Then
Zeichenwert = Zeichenwert + 9333
c = 1
End If
If (Zeichenwert > 96 And Zeichenwert < 123) And Länge = 1 Then
Zeichenwert = Zeichenwert + 9327
c = 1
End If

If Länge = 2 Then
Select Case Zeichen
Case "10"
Zeichenwert = 9321
c = 1
Case "11"
Zeichenwert = 9322
c = 1
Case "12"
Zeichenwert = 9323
c = 1
Case "13"
Zeichenwert = 9324
c = 1
Case "14"
Zeichenwert = 9325
c = 1
Case "15"
Zeichenwert = 9326
c = 1
Case "16"
Zeichenwert = 9327
c = 1
Case "17"
Zeichenwert = 9328
c = 1
Case "18"
Zeichenwert = 9329
c = 1
Case "19"
Zeichenwert = 9330
c = 1
Case "20"
Zeichenwert = 9331
c = 1
End Select
End If

If c = 1 Then
Selection.TypeText ChrW(Zeichenwert)
End If

End Sub
Abgerufen von „https://de.wikibooks.org/w/index.php?title=Plattenbeulen/_Der_Code&oldid=770141“