Word (2003) Formattierungsfrage

[Gast] Foren Programme Office Microsoft Office Word (2003) Formattierungsfrage

Office - Alles fürs Büro

Themen

Beiträge

Moderatoren

Letzter Beitrag

Microsoft Office

1624

6235

29. Feb 2024, 08:40

mudelinchen

1 2

MurphysLaw

Beiträge gesamt: 588

26. Mär 2013, 09:39
Beitrag # 16 von 21
Beitrag ID: #510371
Bewertung:
(2139 mal gelesen)
URL zum Beitrag
Beitrag als Lesezeichen

Antwort auf [ Havi17 ] Antwort 1 ist richtig. Dennoch habe ich das Konstrukt hier äquivalent dargestellt. Kann ich Dir Morgen eine PM mit dem Textauszug schicken ?

Hi Havi,

gerne. Ich verstehe, dass man gewisse Dinge nicht online posten kann/sollte.
Das Problem ist hier nicht das Konstrukt selbst, das dürfte keine Probleme machen. Es muss was mit dem Inhalt zu tun haben.

Ich schau dann nachher mal in PM rein.

als Antwort auf: [#510351]

Word (2003) Formattierungsfrage

MurphysLaw

Beiträge gesamt: 588

26. Mär 2013, 18:05
Beitrag # 17 von 21
Beitrag ID: #510426
Bewertung:
(2112 mal gelesen)
URL zum Beitrag
Beitrag als Lesezeichen

Arg!
OK, ich hab den Fehler.
Hier wird nichts falsch erkannt - nur eine Zeile zuviel gelöscht.
Da hat wohl mein Testdokument nicht genügend mit deinem übereingestimmt.. :-P
Habe die beiden Übeltäterzeilen einfach mal auskommentiert, dann klappts auch:

Code

Sub SortiereKapitelAZ() 
Dim doc As Document, kapitel As Document 
Dim titl As String, inhalt As String 
Dim ranf As Long, tanf As Long, rende As Long 
Dim seiten As Long, pfad As String 
Dim fso As FileSystemObject 
  
Set doc = ActiveDocument 
seiten = doc.ComputeStatistics(wdStatisticPages) 
pfad = doc.Path & "\kapitel" 
Set fso = New FileSystemObject 
If Not fso.FolderExists(pfad) Then 
    fso.CreateFolder pfad 
End If 
  
'Schritt 1: Alle Kapitel aus Dokument ausschneiden und als separate Datei speichern 
With Selection 
    .HomeKey unit:=wdStory 
      
    ranf = .Start 
    With .Find 
        .ClearFormatting 
        .Text = "*\:" 
        .MatchWildcards = True 
        .Execute 
    End With 
      
    For i = 1 To seiten - 1 
        titel = .Text 
        titel = Replace(titel, ":", "") 
        .Collapse wdCollapseEnd 
        tanf = .Start 
          
        With .Find 
            .Text = "^m" 
            .MatchWildcards = False 
            .Execute 
        End With 
          
        rende = .End 
        .Collapse wdCollapseStart 
        .End = .Start 
        .Start = tanf 
        inhalt = .Text 
        .Start = ranf 
        .End = rende 
        .Cut 
        '.Expand unit:=wdLine 
        '.Delete 
        Set kapitel = Documents.Add 
        kapitel.Range.Text = titel & ":" & inhalt 
        kapitel.SaveAs pfad & "\" & titel & ".doc", wdFormatDocument 
        kapitel.Close 
        doc.Activate 
          
        ranf = .Start 
        With .Find 
            .ClearFormatting 
            .Text = "*\:" 
            .MatchWildcards = True 
            .Execute 
        End With 
    Next i 
      
    'Letzte Seite: 
    With .Find 
        .ClearFormatting 
        .Text = "*\:" 
        .MatchWildcards = True 
        .Execute 
    End With 
    titel = .Text 
    titel = Replace(titel, ":", "") 
    .Collapse wdCollapseEnd 
    .End = doc.Range.End 
    inhalt = .Text 
    .Start = doc.Range.Start 
    .Cut 
    Set kapitel = Documents.Add 
    kapitel.Range.Text = titel & ":" & inhalt 
    kapitel.SaveAs pfad & "\" & titel & ".doc", wdFormatDocument 
    kapitel.Close 
    doc.Activate 
    ranf = .Start 
      
'Neu rein verknüpfen 
    With Application.FileSearch 
        .LookIn = pfad 
        .FileName = "*.doc" 
        .Execute msoSortByFileName, msoSortOrderAscending 
    End With 
  
    For i = 1 To Application.FileSearch.FoundFiles.Count - 1 
        .Fields.Add .Range, wdFieldIncludeText, Chr(34) & Replace(Application.FileSearch.FoundFiles(i) & Chr(34), "\", "\\") 
        .Collapse wdCollapseEnd 
        .InsertBreak wdPageBreak 
        ranf = .End + 1 
    Next i 
    'Letzte Seite: 
    .Fields.Add .Range, wdFieldIncludeText, Chr(34) & Replace(Application.FileSearch.FoundFiles(i) & Chr(34), "\", "\\") 
      
End With 
  
MsgBox "Fertig!" 
  
End Sub

Klappt das bei Dir auch?

Grüße,
Murphy

als Antwort auf: [#510351]

Word (2003) Formattierungsfrage

Havi17

Beiträge gesamt: 11

26. Mär 2013, 18:15
Beitrag # 18 von 21
Beitrag ID: #510427
Bewertung:
(2100 mal gelesen)
URL zum Beitrag
Beitrag als Lesezeichen

Hallo Murphy,

kann ich erst Morgen testen, habe das Dokument nicht hier.
Melde mich dann !!

Viele Grüße
Havi17

als Antwort auf: [#510426]

Word (2003) Formattierungsfrage

MurphysLaw

Beiträge gesamt: 588

27. Mär 2013, 11:29
Beitrag # 19 von 21
Beitrag ID: #510456
Bewertung:
(2050 mal gelesen)
URL zum Beitrag
Beitrag als Lesezeichen

Hi Havi17,

ja, ja, so ist das mit den Textauszügen. :-P
==>Das Problem war der mehrseitige Text. So war das Makro beim letzten Text noch nicht auf der letzten Seite, es kam aber auch kein Seitenumbruch mehr. Duirch den Doppelpunkt im Fließtext des letzten Artikels entstand dann der Fehler.
Habe noch eine Sicherheits-Ausstiegsklausel rein gemacht:

Code

Sub SortiereKapitelAZ() 
Dim doc As Document, kapitel As Document 
Dim titl As String, inhalt As String 
Dim ranf As Long, tanf As Long, rende As Long 
Dim seiten As Long, pfad As String 
Dim fso As FileSystemObject 
  
Set doc = ActiveDocument 
seiten = doc.ComputeStatistics(wdStatisticPages) 
pfad = doc.Path & "\kapitel" 
Set fso = New FileSystemObject 
If Not fso.FolderExists(pfad) Then 
    fso.CreateFolder pfad 
End If 
  
'Schritt 1: Alle Kapitel aus Dokument ausschneiden und als separate Datei speichern 
With Selection 
    .HomeKey unit:=wdStory 
      
    ranf = .Start 
    With .Find 
        .ClearFormatting 
        .Text = "*\:" 
        .MatchWildcards = True 
        .Execute 
    End With 
      
    For i = 1 To seiten - 1 
        titel = .Text 
        titel = Replace(titel, ":", "") 
        .Collapse wdCollapseEnd 
        tanf = .Start 
          
        With .Find 
            .Text = "^m" 
            .MatchWildcards = False 
            .Execute 
        End With 
 
        If Not .Find.Found Then GoTo LastPage 'Letzter Artikel 
 
        rende = .End 
        .Collapse wdCollapseStart 
        .End = .Start 
        .Start = tanf 
        inhalt = .Text 
        .Start = ranf 
        .End = rende 
        .Cut 
        '.Expand unit:=wdLine 
        '.Delete 
        Set kapitel = Documents.Add 
        kapitel.Range.Text = titel & ":" & inhalt 
        kapitel.SaveAs pfad & "\" & titel & ".doc", wdFormatDocument 
        kapitel.Close 
        doc.Activate 
          
        ranf = .Start 
        With .Find 
            .ClearFormatting 
            .Text = "*\:" 
            .MatchWildcards = True 
            .Execute 
        End With 
    Next i 
      
    'Letzte Seite: 
 
    With .Find 
        .ClearFormatting 
        .Text = "*\:" 
        .MatchWildcards = True 
        .Execute 
    End With 
    titel = .Text 
    titel = Replace(titel, ":", "") 
 
LastPage: 
    .Collapse wdCollapseEnd 
    .End = doc.Range.End 
    inhalt = .Text 
    .Start = doc.Range.Start 
    .Cut 
    Set kapitel = Documents.Add 
    kapitel.Range.Text = titel & ":" & inhalt 
    kapitel.SaveAs pfad & "\" & titel & ".doc", wdFormatDocument 
    kapitel.Close 
    doc.Activate 
    ranf = .Start 
      
'Neu rein verknüpfen 
    With Application.FileSearch 
        .LookIn = pfad 
        .FileName = "*.doc" 
        .Execute msoSortByFileName, msoSortOrderAscending 
    End With 
  
    For i = 1 To Application.FileSearch.FoundFiles.Count - 1 
        .Fields.Add .Range, wdFieldIncludeText, Chr(34) & Replace(Application.FileSearch.FoundFiles(i) & Chr(34), "\", "\\") 
        .Collapse wdCollapseEnd 
        .InsertBreak wdPageBreak 
        ranf = .End + 1 
    Next i 
    'Letzte Seite: 
    .Fields.Add .Range, wdFieldIncludeText, Chr(34) & Replace(Application.FileSearch.FoundFiles(i) & Chr(34), "\", "\\") 
      
End With 
  
MsgBox "Fertig!" 
  
End Sub