Plattenbeulen/ Der Code
Zur Navigation springen
Zur Suche springen
- 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