Word Makro

Moderator: ModerationP

Re: Word Makro

Beitragvon damienffm » 09. Aug 2021, 06:18

Guten Morgen Theo,

sorry, ich poste hier mal die Beispieldatei wieder umbenannt von docm nach docx. Die Daten sind anonymisiert. Die Datei ist insgesamt verkürzt, denke das ist das Beste.

Grüße
Alexander
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
damienffm
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 31
Registriert: 29. Apr 2020, 08:29
Wohnort: Frankfurt am Main

Re: Word Makro

Beitragvon damienffm » 09. Aug 2021, 07:19

Hallo THeo,

ich poste hier mal eine Beispieldatei, die das wiedergibt, was ich machen möchte. Die Endung docm wurde umbenannt in docx
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
damienffm
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 31
Registriert: 29. Apr 2020, 08:29
Wohnort: Frankfurt am Main

Re: Word Makro

Beitragvon damienffm » 09. Aug 2021, 15:58

Also dieser Code tut das, was ich möchte, er müsste sich nur noch die Variable aus dem Array nehmen

Sub FormVorerkrankungen()
'
Dim strCheck As String
strCheck = (ActiveDocument.Range.Text)
If InStr(strCheck, "Vorerkrankungen") > 0 Then
'
Application.Run "Vorerkrankungen"
End If
End Sub
damienffm
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 31
Registriert: 29. Apr 2020, 08:29
Wohnort: Frankfurt am Main

Re: Word Makro

Beitragvon theoS » 09. Aug 2021, 17:14

Ob du das jetzt mit der Suche oder instr machst ist doch Hose wie Jacke.
Oder hast du so einen lahmen Rechner dass du die Suche merklich in der Zeit spürst?
Ich schau mir das später mal an.
theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5725
Registriert: 19. Apr 2008, 00:14

Re: Word Makro

Beitragvon damienffm » 09. Aug 2021, 18:52

Danke Dir, nein, das macht keinen Unterschied. Eine Verständnisfrage: was meinst du mit Suche oder instr? Wie sähe es denn anders aus?

Ich hab da wirklich wenig Ahnung :?
damienffm
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 31
Registriert: 29. Apr 2020, 08:29
Wohnort: Frankfurt am Main

Re: Word Makro

Beitragvon theoS » 09. Aug 2021, 20:38

Eine Verständnisfrage: was meinst du mit Suche oder instr? Wie sähe es denn anders aus?

Die Suche ist im Regelfall bei mächtigen Dokumenten schneller.

Also, wenn ich deinen Code richtig interpretiere, dann versuchst du deine Schlüsselworte mit TM zu versehen. (wozu?)
Wenn dann in der Prozedur ein Begriff aus einem anderen Array vorkommt, dann soll der wie eine Überschrift formatiert werden?
Wenn es das ist, dann solltest du dir tatsächlich mal ein gutes Buch über Word zulegen. z.B. das von G.O. Thuls. :o)
Die Formatiererei die du hier mit Makros mühsam machst, erledigst du mit Formatvorlagen manuell in der gleichen Zeit.

Noch ein paar Fragen zu deinem Code, denn das zu verstehen ist für die weitere Vorgehensweise nicht unerheblich.
Code: Alles auswählen
  Selection.GoTo What:=wdGoToBookmark, Name:="Vormedikation"
    Selection.GoTo What:=wdGoToBookmark, Name:="\page"

was bezweckt das?
zuerst gehst du zur einen TM, dann zur anderen?
Willst du hier nur die eine Seite formatieren?
Dann ersetzt du mit dem Code hier:
Code: Alles auswählen
With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

alle doppelten Absatzmarken, aber ohne ein Execute passiert erst mal nichts. Dann wiederholst du den Code und machst zweimal hintereinander Execute, das kannst du machen, aber da reicht es, wenn du das Suchfeld einmal ausfüllst.
Sowas macht man mit einer Do-While-Schleife o.ä. Und bitte nicht im Selectionobjekt.
Und wenn die Ersetzung einmal durchgelaufen ist, brauchst du sie nicht mehr zu machen.
Wenn ich das richtig sehe, willst du diesen Code nur bei bestimmten Schlüsselwörtern machen, nicht bei allen?
Dann kannst du das im Prinzip ja nur wieder in einer Schleife mit jedem Schlüsselwort machen. Halt nach der Zuweisung der Bookmarks.
Und jetzt kommt die doofe Frage noch mal: Wozu die Bookmarks?
Wenn du die Schlüsselwörter einfach suchst, dann bekommst du den Range des Wortes, damit auch den Absatz und kannst den ganz bequem mit einer Absatzformatvorlage formatieren.
Aus diesen mit FV formatierten Absätzen/Überschriften kannst du dir auch ein wunderbares Inhaltsverzeichnis bauen. Automatisch.

Wenn du das so weitermachen willst, dann mach aus dem Teil eine Function die du aufrufen willst und gib ihr den TM-Namen mit:
Code: Alles auswählen
Sub NSTB()
'
' Nicht standarmäße Textblöcke formatieren
'
Dim dd1 As Document: Set dd1 = ActiveDocument
Dim rngDoc As Range, strArr As Variant, sI As Long, strNom As String
'in diesen Array kannst du jeden Begriff aufnehmen den du brauchst.
'sollte da noch ein anderes Sonderzeichen drin sein als der : und -
'kannst du unten noch eine Zeile mit Replace einfügen, TM's vertragen keine Sonderzeichen
strArr = Array("Visuelle-Analog-Skala:", "Verlaufs-Diagnosen:", "Operationen:", "Vorerkrankungen:", _
"Vormedikation:", "Sozialanamnese:", "CAM-ICU:", "Beatmungsform:", _
"Kontaktdaten-Angehörige:", "Betreuung:", "Betreuer-Angehörige:", "Vollmacht:", "Patientenverfügung:", "Isolationspflicht:", "Beatmungsparameter:", _
"Neuro-Status:", "Bewusstsein:", "Örtliche-Orientierung:", "Zeitliche-Orientierung:", "Situative-Orientierung:", "Orientierung-Person:", "Glasgow-Coma-Scale-Score:", _
"Verhaltensweise:", "Kardialer-Befund:", "Atmung:", "Befund-Pulmo:", "Abdomenbefund:", "Beatmungsparameter:", _
"Infektiologie:", "SOFA-Score:", "Beatmungsform:", "Beatmungsparameter:", "Temperatur:", "Wunden:", "VW-Wunde:", "Temperatur manuell:", _
"Abschlussbeurteilung Weaning:")

For sI = 0 To UBound(strArr) 'Das Array ist 0-basiert und die Ubound gibt dir immer die Anzahl der drin vorkommenden Elemente an
'hier kommt die Ersetzung der Sonderzeichen:
strNom = strArr(sI)
strNom = Replace(strNom, ":", "")
strNom = Replace(strNom, "-", "")
strNom = Replace(strNom, " ", "")

'da hier eine Schleife läuft, sparst du dir viel Kopiererei und viele Fehlerquellen
Set rngDoc = dd1.Content 'Hier wird vor jeder Suche der Suchbereich auf den Text des Doks gesetzt
rngDoc.Find.ClearFormatting
    rngDoc.Find.Replacement.ClearFormatting
    With rngDoc.Find 'hier fängt die With-Klammer an
        .Text = strArr(sI) 'der Suchbegriff wird aus dem Array genommen
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
         
    End With 'Hier kommt die Fehlermeldung End with ohne with 'weil du das Wort an der verkehrten Stelle hattest, denn hier schließt die With-Klammer
rngDoc.Find.Execute 'dann kommt erst die Ausführung des Befehls.
If rngDoc.Find.Found = True Then  'hier dann die Entscheidung, wenn gefunden, starte ein anderes Makro, das so heißt wie der Rückgabewert von strNom
    formaTier (strNom) 'hier rufst du die Function auf, in den Klammern das Schlüsselwort verkürzt)
End If

  Next sI 'dann zählt das weiter bis der Array mit den Suchbegriffen durch ist
End Sub


Dann kommt die Function, ich hab sie ein wenig umgebaut, denn diese Art der Bearbeitung geht tatsächlich mit dem Selection-Objekt. Blöd wirds dann, wenn du mehr als eine Seite hast. Da musst du dir dann was anderes einfallen lassen.
Code: Alles auswählen
Function formaTier(boomaR)  'hier kommt die TM als String mit rüber
'
' Formatieren Vorerkrankungen Makro
'
    Selection.GoTo What:=wdGoToBookmark, Name:=boomaR 'springt zur Bookmark
    Selection.GoTo What:=wdGoToBookmark, Name:="\page"  'markiert die ganze Seite (das ein Zeichen nach links gehen spar ich mir, weiß nicht wozu)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    Selection.Find.Execute Replace:=wdReplaceAll
    Do While Selection.Find.Found = True 'wenn das gefunden wurde, geht die Schleife weiter, wenn nicht, bricht sie ab
    Selection.Find.Execute Replace:=wdReplaceAll
    Loop

    Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
End Function
theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5725
Registriert: 19. Apr 2008, 00:14

Re: Word Makro

Beitragvon damienffm » 09. Aug 2021, 21:08

Danke Dir werde das am Mittwoch ausprobieren, schaffe es leider vorher nicht.
Also ich bekomme aus einer Applikation ein PDF Dokument übermittelt, was in ein Word Dokument konvertiert werden muss. Leider wird dabei jede Zeile mit einem Zeilenende abgeschlossen, zusätzlich gibt es zwischen zusammenhängendem Text auch mehrere Leerzeilen. Ich stelle dabei die Textmarken je auf eine Seite und markiere den Text zwischen den Textmarken, da sie unterschiedlich lang sein können oder auch gar nicht vorhanden sind. Dann gibt es auch noch Text, der in Tabellen umgewandelt wird.
Ich weiß, meine Programmierung ist in den Augen eines Sachkundigen sicherlich umständlich aber anders konnte ich es nicht umsetzen. Deine Vorschläge sind da schon High Class.
Die TM werden gesetzt um zwischen den TM zu formatieren. Die Makros haben den selben Namen wie die TMs, da ich davon ausging, das der Rückgabewert der Variablen der verkürzte Namen der Textmarke ist. Wenn es hilfreich ist und nicht nervt kann ich Dir ja gerne das gesamt Dokument zu Verfügung stellen, aber nicht lachen :) Ich möchte mich nicht unsterblich blamieren.

Manuell scheidet leider aus, da ich das nicht mache sondern meine Kollegen und die sind da komplett raus.
damienffm
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 31
Registriert: 29. Apr 2020, 08:29
Wohnort: Frankfurt am Main

Re: Word Makro

Beitragvon theoS » 09. Aug 2021, 21:43

Gelacht wird nicht, denn wie soll man das sonst lernen als durch ausprobieren.
Manche Schritte sind dann halt auch mal doppelt, aber das kriegst du schon hin.
Dir fehlen vielleicht einfach die Grundlagen: Was ist eine Schleife, was eine Verzweigung etc.
So grundlegende Sachen findest du z.B. hier: https://vba-tutorial.de/

Musste dich fragen, was du eigentlich willst, denn es gibt etliche elegante Lösungen die Word halt schon hat, die man aber kennen muss um sie anzuwenden. Nicht weil es so "schlecht" programmiert war, sondern weil es anhand des Codes schwer nachzuvollziehen ist, was du genau willst.

Was spricht z.B. dagegen, alle doppelten Zeilenumbrüche generell rauszuwerfen?
Die braucht kein Mensch.
Dann brauchst du die Markiererei nicht sondern kannst gleich weitermachen mit dem Formatieren.
Wenn du weißt, wie die Überschriften werden sollen, leg dir eine Formatvorlage an. Wenn du das Dok nicht auf deinem Rechner bearbeitest oder ein anderer, dann gib das dem Makro mit, dass es die bei Bedarf anlegt.
Solche Sachen erleichtern dir einiges.
Wie auch immer, was machst du mit den Bereichen, die keine TM bekommen?
Hast du ab und zu zwischen den Seitenumbrüchen (kommen auch von der Konvertierung?) auch mehrere Seiten von einer Überschrift zur anderen?

Schau dir das mal an, was ich dir im Beitrag gepostet hab. Die beiden Schnipsel sind das was du brauchst um die verkürzten TM-Namen durchzuschleifen. Ich war mir nicht sicher, ob es sich bei denen um die gleich handelte die aus dem TM-Setz-Makro entstehen würden oder wieder andere.

Vielleicht solltest du mir, statt des Dokuments, eine Liste geben, was das Makro machen soll.
Das mache ich bei meinen Aufgaben auch immer: Sag erst mal laut was es tun soll. Da ich dich nicht höre: Schreib es auf. Formuliere das erst mal in eigenen Worten. Dann kann man das viel leichter in VBA übersetzen.
theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5725
Registriert: 19. Apr 2008, 00:14

Re: Word Makro

Beitragvon damienffm » 09. Aug 2021, 22:11

Danke Dir, ich schicke Dir einfach mal das komplette Dokument, wenn Du den Code startest siehst Du was rauskommen soll. Das funktioniert soweit gut, aber umständlich, aber ich lerne gerne dazu. Was ich nicht getestet habeist, was passiert wenn Überschriften fehlen.
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
damienffm
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 31
Registriert: 29. Apr 2020, 08:29
Wohnort: Frankfurt am Main

Re: Word Makro

Beitragvon theoS » 10. Aug 2021, 21:23

Also entweder hast du mir hier ein verkehrtes Doc geschickt, oder du hast das mit einem anderen formatiert.
Da kann nämlich nichts dabei rauskommen. Das sieht man schon auf den ersten Blick an den roten Zeilen. Da bleibt die Ausführung des Codes nämlich hängen.
Warum hast du Boolsche Werte rausgenommen und durch > 0 ersetzt? Wahrer als Wahr gibt es nicht. (Wenn du true * 1 machst, wirst du zudem erkennen, dass in VBA true = -1 ist, während false = 0 ist.)

Nochmal die Frage: Sind die Schlüsselwörter immer die gleichen? Würde es also reichen, die einmal einzulesen?

Willst du die Leerzeichen ausschließlich in einem Bereich löschen?

Wie du die Tabellen erzeugen möchtest ist mir auch noch ein Rätsel. Wenn du die Suche benutzt, wird die Selection ihren Range auf genau das beschränken, was der Suche zu finden aufgetragen war.
Sprich, wenn du nach ^p suchst, dann wird die Absatzmarke markiert. Daraus lässt sich keine Tabelle bauen. Tut das Makro auch nicht, da kommt eine Fehlermeldung.
In dem Code ist einiges an Verbesserungspotential, weil du ja vieles hintereinander weg machst und eigentlich die meiste Zeit das gleiche.
Wenn ich jetzt wüsste, wie das Ziel aussieht und was du genau willst, dann wär das einfacher.
theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5725
Registriert: 19. Apr 2008, 00:14

Re: Word Makro

Beitragvon damienffm » 11. Aug 2021, 11:48

Hallo Theo,

sorry das war das falsche Dokument.
Ich konnte den Code mittlerweile selbst ein wenig optimieren. Das mit den Boolschen Werten war ein Ergebnis der Suchen und ersetzen Funktion zu fortgerückter Stunde. Ist schon korrigiert.

Die Schlüsselwörter sind, wenn sie vorkommen immer dieselben.

Die mehrfachen Leerzeichen sollen im ganzen Dokument gelöscht werden, ist im neuen Dokument umgesetzt. Das mit dem doppelt hintereinander ausgeführten ^p^p ersetzen durch ^p liegt daraan, dass im Text mehrfach Zeilenumbrüche vorkommen können (2-5). Das im Loop auszuführen funktioniert, wie Du gesagt hast, nicht. Ich führe das selection.find.execute jetzt einfach zweimal hintereinander aus.

Die Tabellen werden korrekt erstellt, egal ob sie leer sind oder mit Text gefüllt sind. Schau es Dir im Beispiel an. Die Markierung mache ich über ein Range, deshalb ist das ^p am Ende der Textmarke mit enthalten. Dann funktioniert es auch wenn die Tabellen leer sind.

Im Moment versuche ich innerhalb eines Dokumentes Und zwischen diesen zu markieren als range wenn sie vorhanden sind.
Du hast keine ausreichende Berechtigung, um die Dateianhänge dieses Beitrags anzusehen.
damienffm
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 31
Registriert: 29. Apr 2020, 08:29
Wohnort: Frankfurt am Main

Re: Word Makro

Beitragvon damienffm » 11. Aug 2021, 14:08

Zur näheren Erläuterung:
1. das was du siehst, wenn Du das Dokument öffnest ist der Rohtext, wie er aus einer anderen Applikation geliefert wird.
2. Ziel ist es, den Text in eine Form zu bringen dessen Gliederung den Textmarken entspricht. Diese sollen auch in der Reihenfolge im Enddokument erscheinen wie sie in der Rohvorlage enthalten sind und fett gedruckt sein.
3. Überflüssige Leerzeichen und Zeilenumbrüche sollen entfernt werden. Diese werden leider in unterschiedlicher Anzahl aus der Applikation mitgegeben. Je nachdem, was der Anwender in die Variablenfelder eingegeben hat. An jedem Zeilenende steht immer ein ^p. Da wo ein Datumsfeld steht gibt es in unterschiedlicher Anzahl mehrfach Leerzeichen.
4. Bei den Textmarken, die bei "Fließtext" angegeben sind, soll Fließtext stehen.
5. Das gesamte Dokument muss Blocksatz formatiert sein. und in Arial 11.
6. Das Dokument darf nicht extern zwischengespeichert werden, das was ich mache ist nur mir gestattet. Der normale Anwender darf das nicht und soll von den Vorgängen auch so wenig wie möglich merken.
7. Der Anwender erstellt in Applikation 1 seinen Bericht, den er via Schnittstelle an Applikation 2 übermittelt. Dort findet er ein PDF welches er eröffnet. Dieses PDF wird an einen Konverter weitergegeben der das PDF in ein TXT umwandelt welches in einer Wordvorlage landet welches mein Makro enthält, das dann ein Word Dokument der CI erstellt. Von da aus geht es per copy und paste in die vorgegebene Briefvorlage.

Das ist jetzt der eigentliche Workflow was das Makro machen soll. Bis auf copy und paste soll alles andere automatisch ablaufen.
damienffm
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 31
Registriert: 29. Apr 2020, 08:29
Wohnort: Frankfurt am Main

Re: Word Makro

Beitragvon theoS » 11. Aug 2021, 14:45

Da kann man was damit anfangen.
Ich schau mal was ich aus deinem Code rausholen kann
Ein wenig später.
theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5725
Registriert: 19. Apr 2008, 00:14

Re: Word Makro

Beitragvon theoS » 11. Aug 2021, 21:36

Das Dokument sieht schon mal ein wenig übersichtlicher aus. :twisted:

Also, du kannst dir viel sparen indem du zB das Dokument nicht in jeder Routine neu deklarierst. Einmal Public deklariert und das bleibt im Speicher nach dem ersten Einlesen.
Dann habe ich dir mal die Formatierung der Schrift und Überschrift mehr an die Word-Konventionen angepasst.
Die beiden ersten Makros laufen jetzt so, dass du Formatierung1 aufrufst und dann am Ende kommt der Befehl, der das nächste Makro aufruft.
Das kannst du natürlich, wenn dir das für dich übersichtlicher erscheint, auch in einem eigenen Makro der Reihe nach aufrufen.
Hier wollte ich dir nur zeigen, dass das kürzer ist als Application.Run

Schau dir das einfach mal an, ich hab ein wenig kommentiert.
Morgen mach ich weiter, denn für deine vielen Einzelmakros habe ich auch schon eine Idee, die in eine Schleife zu packen. Die Pärchen der TMn sind ja immer in der gleichen Reihenfolge, oder?

Code: Alles auswählen
'hier fängt die Deklaration an, direkt über die erste Sub-Zeile
Public dd1 As Document
Public rngCt As Range
Public lngStart As Long, lngEnd As Long, rngS As Range

Sub Formatierung1()
'
'
' SchriftArtGröße Makro
'
Set dd1 = ActiveDocument
Set rngCt = dd1.Content

With dd1.Styles("Standard").Font 'hier setzt du Standard für dieses Dokument auf deine Werte ein
 .Name = "Arial"
 .Size = 9
End With
With dd1.Styles("Überschrift 1") 'das erspart dir dann das "Fetten" und macht ein saubereres Dokument
.Font.Name = "Arial"
.Font.Size = 9
.Font.Bold = True
.Font.ColorIndex = wdBlack
.ParagraphFormat.SpaceBefore = 0
.ParagraphFormat.SpaceAfter = 0
End With


rngCt.Style = "Standard" 'hier setzt du dann den Style ein, schwupp alles ist so formatiert.
'

' Formatierung1
'

    rngCt.Find.ClearFormatting
    rngCt.Find.Replacement.ClearFormatting
    With rngCt.Find
        .Text = "^13{1;}"
        .Replacement.Text = "^13"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    rngCt.Find.Execute Replace:=wdReplaceAll
Set rngCt = dd1.Content
   
    rngCt.Find.ClearFormatting
    rngCt.Find.Replacement.ClearFormatting
    With rngCt.Find
        .Text = "  {1;}"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    rngCt.Find.Execute Replace:=wdReplaceAll
Set rngCt = dd1.Content
    rngCt.Find.ClearFormatting
    rngCt.Find.Replacement.ClearFormatting
    With rngCt.Find
        .Text = "Technisches Dokument! Nicht für den Versand!^p"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = False
    End With
    rngCt.Find.Execute Replace:=wdReplaceAll
   
    Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
    Selection.GoTo What:=wdGoToBookmark, Name:="\page"
    Selection.Delete Unit:=wdCharacter, Count:=1
    Call NewINtEnt.TMsetzen  'so rufst du in einer Prozedur das nächste Makro auf -> Call Modulname.Markoname
End Sub
Sub TMsetzen()
Dim dd1 As Document: Set dd1 = ActiveDocument
Dim rngDoc As Range, strArr As Variant, sI As Long, strNom As String
'in diesen Array kannst du jeden Begriff aufnehmen den du brauchst.
'sollte da noch ein anderes Sonderzeichen drin sein als der : und -
'kannst du unten noch eine Zeile mit Replace einfügen, TM's vertragen keine Sonderzeichen
strArr = Array("ITS-Aufnahmegrund:!", "Visuelle-Analog-Skala:!", "Aufnahmediagnose:!", "Verlaufs-Diagnosen:!", "Operationen:!", "Intensiv-Therapien:!", "Vorerkrankungen:!", _
"Vormedikation:!", "Anamnese-Unfallhergang:!", "Sozialanamnese:!", "Aufnahmebefund-E3:!", "Epikrise:!", "Entlassbefund:!", "CAM-ICU:!", _
"Procedere:!", "Kontaktdaten-Angehörige:!", "Betreuung:!", "Betreuer-Angehörige:!", "Vollmacht:!", "Patientenverfügung:!", "Isolationspflicht:!", "Beatmungsparameter:!", _
"Neuro-Status:!", "Bewusstsein:!", "Örtliche-Orientierung:!", "Zeitliche-Orientierung:!", "Situative-Orientierung:!", "Orientierung-Person:!", "Glasgow-Coma-Scale-Score:!", _
"Verhaltensweise:!", "Kardialer-Befund:!", "Atmung:!", "Befund-Pulmo:!", "Abdomenbefund:!", "Röntgenbefunde:!", "Konsiliarbefunde:!", _
"Infektiologie:!", "SOFA-Score:!", "Beatmungsform:!", "TempM:!", "Temperatur manuell:!", "Wunden:!", "VW-Wunde:!", _
"Medikamente:!", "Bedarfsmedikation:!", "Intervall-Medikation:!", "Perfusoren:!", "Infusionen-Ernährung:!", "Antibiotika-Verlauf:!", "Zugänge:!", _
"Blutprodukte:!", "Abschlussbeurteilung Weaning:!", "Gerät:!", "Ausleitung:!", "Allergien:!")

For sI = 0 To UBound(strArr)
strNom = strArr(sI)
strNom = Replace(strNom, ":!", "")
strNom = Replace(strNom, "-", "")
strNom = Replace(strNom, " ", "")


Set rngDoc = dd1.Content
rngDoc.Find.ClearFormatting
    rngDoc.Find.Replacement.ClearFormatting
    With rngDoc.Find
        .Text = strArr(sI)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    rngDoc.Find.Execute
If rngDoc.Find.Found = True Then
rngDoc.Style = "Überschrift 1" 'das erledigt jetzt auch gleich die "Fettung"
    With dd1.Bookmarks
        .Add Range:=rngDoc, Name:=strNom
    End With
End If
  Next sI


Application.ScreenUpdating = True
End Sub

theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5725
Registriert: 19. Apr 2008, 00:14

Re: Word Makro

Beitragvon theoS » 12. Aug 2021, 21:15

Der Teil der Tabellen erfordert ein wenig Konzentration beim Erstellen des Array, aber ich glaube, der funktioniert ganz gut.
Schau mal ob du damit klar kommst.
Code: Alles auswählen
Sub Tabellen()
Dim rngToTa As Range
Dim BM1 As String, bM2 As String
Dim strBM1 As Variant, strbM2 As Variant
Set dd1 = ActiveDocument 'das ist jetzt zum Testen drin, wenn du das sub aus dem vorigen sub aufrufst, dann brauchst du das nicht
                        ' kann aber gut auch drin bleiben

'
'hier baust du diesesmal 2 der Arrays auf, die Art ist ein wenig anders.
'die Split-Funktion zerlegt einen String an einem Zeichen in einen Array, hier ist das Trennzeichen das |
'Oacht: die Reihenfolge in beiden muss immer dem Paar entsprechen das abgefragt wird.
'da fehlen noch ein paar Paare
strBM1 = Split("AntibiotikaVerlauf|AbschlussBeurteilungWeaning|Epikrise|AufnahmebefundE3|AnamneseUnfallhergang|Medikamente|" _
& "IntervallMedikation|Bedarfsmedikation|Perfusoren", "|")
strbM2 = Split("Zugänge|Medikamente|Entlassbefund|Epikrise|AufnahmebefundE3|IntervallMedikation|" & _
"Bedarfsmedikation|Perfusoren|InfusionenErnährung", "|")

For i = 0 To UBound(strBM1)
BM1 = strBM1(i) 'die Zuweisung zu einer richtigen Stringvariable muss wegend er Übergabe zur Funktion sein
bM2 = strbM2(i)

Set rngToTa = rangeFuerTabelle(BM1, bM2) 'Hier ruft das Makro die Funktion auf, die den Range zurückliefert

If Not rngToTa Is Nothing Then 'Überprüfung ob denn ein Wert zurückgegeben wurde, sonst tut es nichts
    rngToTa.ConvertToTable Separator:=wdSeparateByCommas, NumColumns:=3, _
      NumRows:=7, AutoFitBehavior:=wdAutoFitFixed
   'das habe ich jetzt so gelassen, nur auf den range bezogen
   With rngToTa.Tables(1)
       .Style = "Tabellenraster"
       .ApplyStyleHeadingRows = True
       .ApplyStyleLastRow = False
       .ApplyStyleFirstColumn = True
       .ApplyStyleLastColumn = False
   End With
 End If
Next

End Sub

Function rangeFuerTabelle(strBookmark1 As String, strBookmark2 As String) As Range
'Die Funktion muss mit den beiden Parametern aufgerufen werden! Sonst tut sich da nix
'das ist die Funktion die dir den Range vom Ende der Startbookmark bis zum dem Zeichen vor dem Anfang der Endbookmark ermittelt
If dd1.Bookmarks.Exists(strBookmark1) And dd1.Bookmarks.Exists(strBookmark2) Then
  lngStart = dd1.Bookmarks(strBookmark1).Range.Paragraphs(1).Range.End - 1 'also vom Ende des Absatzes(!) der ersten Bookmark
  lngEnd = dd1.Bookmarks(strBookmark2).Range.Start - 1 'bis zum Anfang der zweiten Bookmark, aber ein Zeichen vorher
  Set rngS = dd1.Range(lngStart, lngEnd) 'hier wird der Range gesetzt
  'rngS.Select  'umd das zu beobachten kannst du den Kommentar rausnehmen
  End If
  Set rangeFuerTabelle = rngS
End Function
theo s.
Benutzeravatar
theoS
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 5725
Registriert: 19. Apr 2008, 00:14

VorherigeNächste

Zurück zu Word Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 20 Gäste