Thema Datum  Von Nutzer Rating
Antwort
Rot Textmarken
 10.05.2020 11:07:32 RH98
NotSolved

Ansicht des Beitrags:
Von:
RH98		 Datum:
10.05.2020 11:07:32		 Views:
1009		 Rating:
     
Antwort:
  Ja
Thema:
Textmarken

Hallo Leute,

ich bin dabei ein Word-Makro zu schreiben, welches folgende Funktion besitzt:

Im Dokument sind verschiedene Textmarken enthalten, welche das Dokument quasi thematisch unterteilen. Ein Thema beginnt mit einer Textmarke und endet mit der nächsten Textmarke, welche wiederum den Beginn eines neuen Themas darstellt. Das letzte Thema soll von der letzten Textmarke bis zum Ende des Dokumentes gehen. Das Marko soll das gesamte Dokument durchlaufen und alle Themen, wie gesagt beginnend mit der Textmarke, auf ein neues Blatt kopieren. Das heißt zu jeder vorhandenen Textmarke im Dokument wird ein neues Dokument erstellt und der Inhalt zwischen den Textmarken, bzw. zwischen der letzten Textmarke und dem Ende des Dokuments soll auf diese leere Seite/dieses neue Dokument kopiert, bzw. eingefügt werden. Das Ziel ist es also, für jedes Themengebiet, welche von Textmarken quasi wie Überschriften vorgegeben werden, ein einzelnes Word-Dokument zu haben.

Ich habe bereits viel versucht und es klappt sogar. Jedoch klappt es manchmal, dann teste ich es ein zweites mal ohne einen Parameter zu verändern und es klappt wieder nicht, dann fehlt einmal eine Textmarke, also eine ganze Seite, dann ist sie mal wieder da. Das Problem liegt also irgendwie an der Unregelmäßigkeit.

Vielleicht ist hier jemand ein Experte und kann mir dabei fix helfen, ich wäre auf jeden Fall sehr dankbar!

 

Hier mal der soweit unzuverlässige Quellcode von mir:

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
' ########################################################## T E X T M A R K E N #############################################################################################################################################
Dim aDoc As Word.Document
Dim x As Long, i As Long
Dim BookMarkRange As Word.Range
Set aDoc = ActiveDocument
     
If aDoc.Bookmarks.Count >= 1 Then ' Zun?chst wird gepr?ft, ob ?berhaupt Textmarken im Dokument enthalten sind
    ' Abspeichern der Textmarken in Array:
    i = 0
        ' ReDim strArray(aDoc.Bookmarks.Count, 1)
        For Each BookMarkRange In aDoc.StoryRanges
            Do While Not BookMarkRange Is Nothing
                If BookMarkRange.StoryType = wdMainTextStory Then ' Bookmarks in Fu?noten oder Kopfzeilen z?hlen nicht, nur Haupttext
                        For x = 1 To BookMarkRange.Bookmarks.Count
                            i = i + 1
                            strArray(i) = BookMarkRange.Bookmarks(x).Name 'Name der Textmarke abspeichern
                        Next x
                End If
                Set BookMarkRange = BookMarkRange.NextStoryRange
            Loop
        Next
         
         
       For x = 1 To i
        If x <= i Then
            Dim y As String
            y = strArray(x + 1)
            ' Text zwischen zwei Textmarken markieren:
             
           ' Version 1:
            'If aDoc.Bookmarks.Exists(strArray(x)) And aDoc.Bookmarks.Exists(y) Then
            '    aDoc.Range(Start:=aDoc.Bookmarks(strArray(x)).Range.Start, _
            '       End:=aDoc.Bookmarks(y).Range.Start).Select
                    
            '
            '
 
 
 
 
            ' Version 2:
            Dim oRange As Range
             
             
            
            If aDoc.Bookmarks.Exists(strArray(x)) And aDoc.Bookmarks.Exists(y) Then
                Set oRange = aDoc.Range(Start:=aDoc.Bookmarks(strArray(x)).Range.Start, _
                            End:=aDoc.Bookmarks(y).Range.Start)
                oRange.Select
                    
                    
                    
                    
          
            Else
                MsgBox "Es ist ein Fehler aufgetreten: Die Textmarken `" & strArray(x) & "` oder `" & y & "` existieren nicht mehr."
            End If
        Else
             
           
            ' Text zwischen der letzten Textmarke und dem Blattende markieren
            aDoc.Range(Start:=aDoc.Bookmarks(strArray(x)).Range.Start, End:=aDoc.Range.End).Select
        End If
         Selection.Copy
         Dim nDoc As Word.Document
         Set nDoc = Documents.Add  ' ?ffnet neues Dokument
         Selection.Paste 'f?gt alles kopierte dort ein

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Textmarken
 10.05.2020 11:07:32 RH98
NotSolved