*.doc aufteilen...

[gordon freeman]

Hallo Leute,
ich habe mit Hilfe von GeorgWNewbie schon ein ganz ordentliches Makro gebastelt, dass aus einer Doc-Datei mehrere HTML-Dateien macht. Hier der Code:

Code:

Private Sub CommandButton1_Click()
a = TextBox1.Text
b = TextBox2.Text
c = 0
d = 0
markieren
End Sub


Sub markieren()
While c = 0

d = d + 1

Dim FirstPos, SecPos As Integer

FirstPos = -1
SecPos = -1

ActiveDocument.Range(0, 0).Select

Do While FirstPos = -1 Or SecPos = -1
    With Selection.Find
        .ClearFormatting
        .Font.Size = a
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    If Not Selection.Find.Found Then
     c = 1
    End If
    
    If FirstPos = -1 Then
      FirstPos = Selection.Start
    ElseIf SecPos = -1 Then
      SecPos = Selection.Start
    End If
Loop

If FirstPos <> -1 And SecPos <> -1 Then
  Selection.Start = FirstPos
  Selection.End = SecPos
End If


Selection.Cut
Documents.Add Template:="", NewTemplate:=False, DocumentType:=1
Selection.Paste


ChangeFileOpenDirectory b
    ActiveDocument.SaveAs FileName:=d + ".htm", FileFormat:=wdFormatHTML, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False
Wend

Selection.WholeStory

Selection.Cut
Documents.Add Template:="", NewTemplate:=False, DocumentType:=1
Selection.Paste


ChangeFileOpenDirectory b
    ActiveDocument.SaveAs FileName:=d + ".htm", FileFormat:=wdFormatHTML, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False

End Sub

Das Problem ist, dass ich diesen code noch nicht testen konnte, da er an folgender Stelle immer einen Laufzeitfehler ausgibt:

Code:

.ClearFormatting
        .Font.Size = a        <-- An dieser Stelle erscheint der Fehler!!!
        .Text = ""
        .Replacement.Text = ""

Wahrscheinlich werden weitere Fehler auftauchen, aber vieleicht kann mir ja einer von euch sagen, was ich an dieser Stelle falsch gemacht habe

bua, tia, cu gordon

[Dagon]

In Delphi wäre der Fehler, das a nicht vom Typ Integer ist sonder vom Typ String. Aber wie das in VB ist weiss ich nicht mehr. Du müsstest a folglich in einen Interger umwandeln.

[gordon freeman]

Zitat von the_master:

Du müsstest a folglich in einen Interger umwandeln.

Ich habe versucht a, bei der Deklaration von FirstPos und Secpos mit als Integer zu definieren, der Fehler bleibt aber der selbe

[sakura]

Versuche mal alle Variablen statt diese z.B. als Integer zu definieren diese als OleVariant zu definieren. Vielleicht klappt das ja

......

[gordon freeman]

Zitat von sakura:

...diese als OleVariant zu definieren.
......

Sorry Sakura, das haut 'net hin. Den Ole-Variant gibt es wohl unter VBA nicht, auf jeden Fall erkennt ihn VBA nicht als Variablen-Typ.

trotzdem Danke für die Anregung

[sakura]

Achso, ich hatte mich geirrt und dachte, Du willst es nach Delphi portieren Dann schreibe z.B. nur Dim FirstPos, SecPos, lasse den Typ weg und schon sind es Variants

......

[Robert_G]

Hi Gordon,
schreibe mal ganz oben in der ersten Zeile des Moduls "option explicit" rein.
Ab jetzt kann st du nur noch Variablen verwenden, die du auch deklariert hast. (irgendein Schreibfehler wird sonst als Variable erkannt und du kriegst es nicht mit!)

Mit:

Delphi-Quellcode:

        .ClearFormatting 
        .Font.Size = a

Suchst du alle Textstellen in denen die Schriftgröße dem Inhalt von Textbox1 entspricht. Ich weiß nicht, ob das ohne ein Font funktioniert.

Versuche es mal mit:

Delphi-Quellcode:

        .ClearFormatting 
        .Font.Name = "Courier New"
        .Font.Size = a

[gordon freeman]

Ha ich gemacht, doch.....

Code:

Einer der Werte, die an diese Methode oder Eigenschaft übergeben wurde, steht außerhalb des gültigen Bereiches!

Damit ist a gemeint, aber was bedeutet das jetzt


[edit] Das a Problem ist bereits gelöst...(s. code im nächsten Beitrag) [/edit]

[gordon freeman]

Hier der "neue" Code:

Code:

Dim FirstPos, SecPos, a, c, d As Integer
Dim E As String

Private Sub CommandButton1_Click()
a = CInt(TextBox1.Text)
b = TextBox2.Text
c = 0
d = 0
markieren
End Sub

Sub markieren()
While c = 0

d = d + 1


FirstPos = -1
SecPos = -1

ActiveDocument.Range(0, 0).Select

Do While FirstPos = -1 Or SecPos = -1
    With Selection.Find
        .ClearFormatting
        .Font.Size = a
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    If Not Selection.Find.Found Then
     c = 1                                                                                    2)
     Exit Do
    End If
    
    If FirstPos = -1 Then
      FirstPos = Selection.Start
    ElseIf SecPos = -1 Then
      SecPos = Selection.Start
    End If
Loop

If FirstPos <> -1 And SecPos <> -1 Then
  Selection.Start = FirstPos
  Selection.End = SecPos
End If

If c = 0 Then                                                                                 1)                  

Selection.Cut                                                                                 3)
Documents.Add Template:="", NewTemplate:=False, DocumentType:=1
Selection.Paste

E = Str(d)

ChangeFileOpenDirectory "C:\martin\HTML\"
    ActiveDocument.SaveAs FileName:=E + ".htm", FileFormat:=wdFormatHTML, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False

        ActiveWindow.Close

Else

Selection.WholeStory

Selection.Cut
Documents.Add Template:="", NewTemplate:=False, DocumentType:=1
Selection.Paste

E = Str(d)

ChangeFileOpenDirectory "C:\martin\HTML\"
    ActiveDocument.SaveAs FileName:=E + ".htm", FileFormat:=wdFormatHTML, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False

        ActiveWindow.Close

End If
Wend
End Sub

1) Der Rechner fragt an der Stelle

Code:

If c = 0 Then

2) ab, ob etwas markiert wurde. Dies soll widerum an der Stelle:

Code:

If Not Selection.Find.Found Then
     c = 1
     Exit Do
    End If

3) festgelegt werden. Allerdings übergeht der Rechner diese Abfrage und Gibt bei

Code:

Selection.Cut

eine Exception aus, da nichts markiert wurde und er somit nichts ausschneiden kann. Falls aber nichts markiert wurde sollte der Rechner eigentlich das gesamte Dokument markieren:

Code:

Else

Selection.WholeStory

Wieso tut er das nicht

bua, tia, cu gordon

[Robert_G]

Durch...
        .Wrap = wdFindContinue ... wird er immer wieder vom Start aus suchen, wenn er nichts gefunden hat.
So verhinderst du das:
        .Wrap = wdFindStop Außerdem noch das hier und es müsste funktionieren...

Delphi-Quellcode:

    If FirstPos = -1 Then
      FirstPos = Selection.Start
    ElseIf SecPos = -1 Then
      SecPos = Selection.Start
    End If
    ' Das hier verschiebt den Cursor hinter den gefundenen Text
    Selection.Start = Selection.End

Nachtrag: Beim nächsten Mal den Code als Anhang, man scrollt sich ja sonst noch die Maus wund