Absatznummer für Kommentar-Fundstelle

Dieses Thema Absatznummer für Kommentar-Fundstelle im Forum "Microsoft Office Suite" wurde erstellt von sir_falcon, 20. Juni 2005.

Thema: Absatznummer für Kommentar-Fundstelle Hallo, ich habe ein Makro geschrieben, um aus einem Text (Dokument) alle Kommentare zu extrahieren und...

  1. Hallo,

    ich habe ein Makro geschrieben, um aus einem Text (Dokument) alle Kommentare zu extrahieren und übersichtliche in einer neuen Datei zu speichern. Dabei werden einige Informationen zur Fundstelle des Kommentars mit ausgelesen. (Inhalt des Kommentars, Seite, Scope)
    Was ich jetzt noch gerne mit herausfinden würde, ist die Absatznummer der Stelle, an der der Kommentar steht.

    Hat jemand eine Idee?

    Grüße

    Sir Falcon
     
  2. Hi,

    Also hier vielleicht noch mal eine andere Frage dazu:
    Wie bekomme ich zu einem beliebigen Stück Text aus einem Dokument die zugehörige Absatznumerierung (Kapitelnummer) heraus?

    Sir Falcon
     
  3. Hallo sir_falcon,

    die Absatznummer kannst Du folgendermassen feststellen:
    Code:
    Sub KommentarAbsatznummer()
      Dim kom As Comment
      For Each kom In ActiveDocument.Comments
        kom.Scope.Select
        l_ParagrahenNummer = ActiveDocument.Range(Start:=pos, End:=Selection.End).Paragraphs.Count
      Next
    End Sub
    Bei Absatznummerierung bin ich ein wenig ratlos, da nicht jeder Absatz eine Nummerierung hat.

    Gruß Matjes :)
     
  4. Hallo,

    also ich hab ein wenig experimentiert.
    Ich dachte ich könnte - ausgehend von der Fundstelle - die Range rückwärts erweitern zur nächsten (vorherigen) Überschrift

    Code:
      Dim com As Comment
      Dim r As Range
    
      For i = 1 to doc1.Comments.Count
        Set com = doc1.Comments.Item(i)
        Set r = com.Scope
        r.GoTo what:=wdGoToHeading, which:=wdGoToPrevious, Count:=1
        r.Expand unit:=wdSentence
        MsgBox Kapitelüberschrift= & r.Text
      Next
    
    
    klappt nur leider nicht.
    Die Range bleibt unverändert :mad:

    Gruß

    Sir Falcon
     
  5. Hi sir_falcon,

    ich hab mal einen Makro zusammengestellt, der für alle Kommentare jeweils eine Meldung zusammenstellt.

    Meldung:
    - Kommentar-Nummer
    - Kommentar
    - Absatznummer in dem der kommentar steht
    - Überschrift der nächst höhergelegenen Überschrift
    - Überschriften-Nummerierung (als 0.0.0.0.0), wenn eine automatische Nummerierung (Feld AUTODEZ) vorliegt.

    Probier ihn mal aus.

    Gruß matjes :)
    Code:
    Option Explicit
    Sub KommentarAbsatznummer()
    
     ->** für jeden Kommentar erfolgt eine Meldung mit:
     ->** - Kommentarnummer
     ->** - Kommentar
     ->** - Absatznummer
     ->** - Absatznummerierung der nächsten darüberliegenden Überschrift
     ->** - Überschrift der nächsten darüberliegenden Überschrift
    
      Dim kom As Comment, l_kom As Long, t As String, t2 As Long, n As Long
      Dim s_Ueberschrift As String, s_Ueberschrift_full As String
      Dim l_ParagrahenNummer As Long, s_ParNum As String
      Dim doc As Document, x As Long, s As Long, h As Long, l_num As Long
      Dim f_style(1 To 9) As Long, l_start As Long, l_end As Long
      
     ->Feld der Überschriften-Styles
      f_style(1) = wdStyleHeading1
      f_style(2) = wdStyleHeading2
      f_style(3) = wdStyleHeading3
      f_style(4) = wdStyleHeading4
      f_style(5) = wdStyleHeading5
      f_style(6) = wdStyleHeading6
      f_style(7) = wdStyleHeading7
      f_style(8) = wdStyleHeading8
      f_style(9) = wdStyleHeading9
      
      
      Set doc = ActiveDocument
      
     ->alle Kommentare
      For Each kom In ActiveDocument.Comments
        
       ->Kommentar selektieen
        kom.Scope.Select
        
       ->betreffende Paragrahennummer feststellen
        l_ParagrahenNummer = doc.Range(Start:=1, End:=Selection.End).Paragraphs.Count
        
       ->nächst höhergelegene Überschrift suchen
        s_ParNum = kein Überschriften Absatz vor dem Kommentar
        For x = l_ParagrahenNummer To 1 Step -1
          For s = LBound(f_style()) To UBound(f_style())
           ->Paragraph mit Überschriften-Format ?
            If doc.Paragraphs(x).Style = doc.Styles(f_style(s)) Then
              
             ->Überschrift gefunden
              
             ->Überschrift lesen
              s_Ueberschrift_full = doc.Paragraphs(x).Range.Text
              s_Ueberschrift = 
             ->Schmierzeichen ausblenden
              For n = 1 To Len(s_Ueberschrift_full)
                t = Mid(s_Ueberschrift_full, n, 1)
                t2 = Asc(t)
                Select Case t2
                  Case 0 To 31
                  Case Else
                    s_Ueberschrift = s_Ueberschrift & t
                End Select
              Next
              
             ->automatische Nummerierung des Absatzes prüfen
              On Error Resume Next
              s_ParNum = 
             ->dies sollte eigentlich das Nummerierungsfeld als Text liefern
              s_ParNum = doc.Paragraphs(x).Range.Fields(1).Result.Text
              If Err.Number <> 0 Then
               ->Überschrift ohne Feld automatische Nummerierung
                Err.Clear
                s_ParNum = Überschrift gefunden, aber keine automatische Nummerierung
                On Error GoTo 0
                GoTo Ergebnis
              End If
                
             ->Überschrift mit automatischer Nummerierung gefunden
             ->Nummerierung kann aber nicht mittels Result.Text ermittelt werden
             ->-> Nummerierung zu Fuß ermitteln
              
             ->Suchbereich Überschrift-Paragraph bis Doc-Anfang setzen
              l_start = doc.Paragraphs(1).Range.Start
              l_end = doc.Paragraphs(x).Range.End
              s_ParNum = 
              
             ->für Überschrift-Stil 1 bis zu dem des gefundenen Überschriften-Paragraphen
              For h = 1 To s
               ->relevanten Suchbereich setzen
                doc.Range(Start:=l_start, End:=l_end).Select
               ->Anzahl der Paragraphen mit betreffendem Überschriften-Stil
                With Selection.Find
                  .ClearFormatting
                  .Style = f_style(h)
                  .Forward = True
                  .Format = True
                  .Wrap = wdFindStop
                  .Text = 
                  l_num = 0
                  Do While Selection.Find.Execute() = True
                   ->Wenn Fundstelle nach dem Betreffenden Uberschriften-Paragraphen,
                   ->dann weiter Suche abbrechen
                    If Selection.End > l_end Then Exit Do
                   ->Überschriften zählen
                    l_num = l_num + 1
                   ->nächsten Suchbereichsanfang hinter die Fundstelle setzen
                    l_start = Selection.End + 1
                   ->Suchbereich auf beschränkten Bereich setzen
                    doc.Range(Start:=l_start, End:=l_end).Select
                  Loop
                End With
               ->Anzahl der gefundenen Überschriften als Nummerierung anfügen
                s_ParNum = s_ParNum & l_num & .
              Next
              GoTo Ergebnis
            End If
          Next
        Next
    Ergebnis:
        
       ->*** Ergebnis für diesen Kommentar ausgeben
        l_kom = l_kom + 1->Kommentar zählen
        kom.Scope.Select ->Kommentar selektieren
        MsgBox ( _
          Kommentar Nr.  & l_kom & vbCrLf & vbCrLf & _
          Kommentar   :  & vbCrLf & kom.Range.Text & vbCrLf & vbCrLf & _
          Absatznummer:  & l_ParagrahenNummer & vbCrLf & _
          In Abschnitt:  & s_ParNum & vbCrLf & _
          Überschrift :  & s_Ueberschrift)
        
      Next
    Aufraeumen:
      Set kom = Nothing: Set doc = Nothing
    End Sub
     
  6. Hi Matjes,

    danke für das Makro.

    Hat mir super weiter geholfen. :)

    Gruß

    Sir Falcon
     
Die Seite wird geladen...

Absatznummer für Kommentar-Fundstelle - Ähnliche Themen

Forum Datum
Software für Partition Verwaltung Software: Empfehlungen, Gesuche & Problemlösungen 29. Nov. 2016
windows für kinder sicher machen ? Windows 10 Forum 11. Nov. 2016
Drucker für Gast freigeben Netzwerk 7. Nov. 2016
Welches Programm für mkv unter Windows? Audio, Video und Brennen 23. Aug. 2016
Software für DVD-Kopien on the fly Software: Empfehlungen, Gesuche & Problemlösungen 29. Juli 2016