VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
VBA Problem mit Word 2010	20.10.2011 19:36:38	Mario
VBA Problem mit Word 2010	22.10.2011 01:42:09	Till
VBA Problem mit Word 2010	22.10.2011 11:04:36	Mario
VBA Problem mit Word 2010	22.10.2011 12:01:59	Till
VBA Problem mit Word 2010	22.10.2011 12:06:35	Mario

Ansicht des Beitrags:

Von:
Mario

Datum:
20.10.2011 19:36:38

Views:
2099

Rating:

Antwort:

Thema:
VBA Problem mit Word 2010

Hallo!

Ich habe ein Formular übernommen, welches Word Dokumente öffnet und zusammen kopiert.

Bis jetzt hat alles funktioniert, jedoch mit Word 2010 gibt es Probleme.

Wenn ich mehr als drei bis vier Dokumente auswähle, gibt es einen Runtime Error.

Wer kann mir hier helfen?

Anbei der Code.

Danke im Voraus,

Mario

Private m_iList As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Datum As String
Private Druckanzahl
Public PolNR As String
Public Datei1 As String
Public DateiNeu As String

Public Enum eType
Ausw = 0
Dateinamen = 1
End Enum
Private Sub cmdAuswahl_Click()
AddFileToList Ausw, fileQuelle.FileName, AddBackslash(fileQuelle.Path) & fileQuelle.FileName
End Sub
Private Sub cmdDruck_Click()

Dim AnzahlDokumente         As Long 'Anzahl der zu vereinigenden Dokumente
Dim lCounter                As Long
Dim DocumentName            As String
Dim vDocument               As Variant
Dim WinWordProg As Object   'Word für Windows als Objekt
Dim i As Long
Dim x As String

   AnzahlDokumente = lstAusgewaehlteDateinamen(1).ListCount

    If AnzahlDokumente = 0 Then
        MsgBox "Bitte wählen Sie zuerst eine Maklerklausel aus!"
        Exit Sub
    End If

'On Error Resume Next
' Prüfung auf allgemeine Maklerklausel
For i = 0 To AnzahlDokumente - 1
    x = lstAusgewaehlteDateinamen(1).List(i)
    If lstAusgewaehlteDateinamen(1).List(i) = "x:\PERM\Abt_Sach-Breite\Vertragsgrundlagen\Maklerklauseln\10 G0 301 0_Maklerklausel.doc" _
        And txtMakleranschrift.Text = "" Then
        frmMakleranschrift.Visible = True
        txtMakleranschrift.Visible = True
        MsgBox "Bitte Name und Anschrift des Maklers eingeben und anschließend Maklerlauseln drucken!", vbInformation
        Exit Sub
    End If
Next i
    txtDruckstatus.Visible = True
    PolNR = txtPolizzennummer.Text
    Datei1 = lstAusgewaehlteDateinamen(1).List(i)

'Jetzt wird mittels einer Schleife jener Bereich durchlaufen, in der die zu
'vereinigenden Dokumente stehen
        Set WinWordProg = CreateObject("Word.Application")
                WinWordProg.Visible = True

        'WinWordProg.Documents.Add
        'DateiNeu = WinWordProg.application.activeDocument.Name
For i = 0 To AnzahlDokumente - 1
    If i = 0 Then
        'Öffnen von Word
        Set WinWordProg = CreateObject("Word.Application")
        WinWordProg.Visible = True
        'Dokument öffnen
        PolNR = txtPolizzennummer.Text
        Datei1 = lstAusgewaehlteDateinamen(1).List(i)
        WinWordProg.Documents.Open FileName:=Datei1

        WinWordProg.Selection.WholeStory
        WinWordProg.Selection.HomeKey
        WinWordProg.Selection.Font.Size = 13
        WinWordProg.Selection.Font.Name = "Helvetica Fett"
        If PolNR = "" Then
            WinWordProg.Selection.TypeText Text:="Besondere Vereinbarungen"
         Else
            WinWordProg.Selection.TypeText Text:="Besondere Vereinbarungen zu Polizzennummer " & PolNR
        End If
        WinWordProg.Selection.TypeParagraph
        'Prüfung auf Allgem. Maklerdokument und Erstellung jenes
        If lstAusgewaehlteDateinamen(1).List(i) = "x:\PERM\Abt_Sach-Breite\Vertragsgrundlagen\Maklerklauseln\10 G0 301 0_Maklerklausel.doc" Then
            WinWordProg.Selection.WholeStory
            WinWordProg.Selection.EndKey
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.TypeText Text:="Maklerklausel (10G03010)"
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.Font.Name = "Helvetica Normal"
            WinWordProg.Selection.Font.Size = 11
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.TypeText Text:= _
            "Der gesamte Geschäftsverkehr im Zusammenhang mit gegenständlichem Vertrag wird mit dem Versicherungsmakler " & txtMakleranschrift.Text & _
            " abgewickelt."
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.TypeText Text:= _
            "Anzeigen und Erklärungen des Versicherungsnehmers gelten dem Versicherer als zugegangen, wenn diese bei " & txtMakleranschrift.Text & _
            " eingelangt sind. Der Makler ist zu deren unverzüglichen Weiterleitung an den Versicherer verpflichtet."
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.TypeText Text:= _
            "Versicherungsanträge sowie Anzeigen und Willenserklärungen des Versicherungsnehmers, die ein Versicherungsverhältnis begründen oder den " & _
            "Deckungsumfang eines bestehenden Vertragsverhältnisses erweitern sollen, gelten jedoch erst mit ihrem tatsächlichen Eingang beim Versicherer als diesem zugegangen."
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.TypeText Text:= _
            "Der Versicherer akzeptiert bei den Fristen gemäß §§ 38 und 39 VersVG eine angemessene Verlängerung für die Prüfungspflicht des Maklers " & _
            "sowie den Postlauf vom Makler zum Versicherungsnehmer."
            WinWordProg.Selection.TypeParagraph
            WinWordProg.Selection.WholeStory
            WinWordProg.Selection.Font.Bold = wdToggle
        End If

        'Prüfung auf Kündigungsklauseln
        If lstAusgewaehlteDateinamen(1).List(i) = "x:\PERM\Abt_Sach-Breite\Vertragsgrundlagen\Maklerklauseln\10 G0 324 0_Jährliche Kündbarkeit mit Rabattverzicht.doc" Or _
        lstAusgewaehlteDateinamen(1).List(i) = "x:\PERM\Abt_Sach-Breite\Vertragsgrundlagen\Maklerklauseln\10 G0 325 0_Jährliche Kündbarkeit.doc" Then
            WinWordProg.Selection.WholeStory
            WinWordProg.Selection.Find.ClearFormatting
            WinWordProg.Selection.Find.Replacement.ClearFormatting
            With WinWordProg.Selection.Find
                .Text = "Datum"
            End With
            WinWordProg.Selection.Find.Execute
            WinWordProg.Selection.Delete
            WinWordProg.Selection.TypeText Text:=Datum & " "
        End If

        'Absatz zwischen 1. u. 2. Dokument setzen
        WinWordProg.Selection.WholeStory
        WinWordProg.Selection.EndKey
        WinWordProg.Selection.TypeParagraph

    Else
    'Dokument öffnen
    WinWordProg.Documents.Open FileName:=lstAusgewaehlteDateinamen(1).List(i)
    ' gerade geöffnetes Dokument aktivieren (ist wahrscheinlich ohnehin schon aktiviert aber sicher ist sicher)
    If lstAusgewaehlteDateinamen(1).List(i) = "x:\PERM\Abt_Sach-Breite\Vertragsgrundlagen\Maklerklauseln\10 G0 301 0_Maklerklausel.doc" Then
        WinWordProg.Selection.WholeStory
        WinWordProg.Selection.EndKey
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.Font.Size = 13
        WinWordProg.Selection.Font.Name = "Helvetica Fett"
        WinWordProg.Selection.TypeText Text:="Maklerklausel (10G03010)"
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.Font.Name = "Helvetica Normal"
        WinWordProg.Selection.Font.Size = 11
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.TypeText Text:= _
        "Der gesamte Geschäftsverkehr im Zusammenhang mit gegenständlichem Vertrag wird mit dem Versicherungsmakler " & txtMakleranschrift.Text & _
        " abgewickelt."
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.TypeText Text:= _
        "Anzeigen und Erklärungen des Versicherungsnehmers gelten dem Versicherer als zugegangen, wenn diese bei " & txtMakleranschrift.Text & _
        " eingelangt sind. Der Makler ist zu deren unverzüglichen Weiterleitung an den Versicherer verpflichtet."
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.TypeText Text:= _
        "Versicherungsanträge sowie Anzeigen und Willenserklärungen des Versicherungsnehmers, die ein Versicherungsverhältnis begründen oder den " & _
        "Deckungsumfang eines bestehenden Vertragsverhältnisses erweitern sollen, gelten jedoch erst mit ihrem tatsächlichen Eingang beim Versicherer als diesem zugegangen."
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.TypeText Text:= _
        "Der Versicherer akzeptiert bei den Fristen gemäß §§ 38 und 39 VersVG eine angemessene Verlängerung für die Prüfungspflicht des Maklers " & _
        "sowie den Postlauf vom Makler zum Versicherungsnehmer."
        WinWordProg.Selection.TypeParagraph
        WinWordProg.Selection.WholeStory
        WinWordProg.Selection.Font.Bold = wdToggle
    End If
        'Prüfung auf Kündigungsklauseln
        If lstAusgewaehlteDateinamen(1).List(i) = "x:\PERM\Abt_Sach-Breite\Vertragsgrundlagen\Maklerklauseln\10 G0 324 0_Jährliche Kündbarkeit mit Rabattverzicht.doc" Or _
        lstAusgewaehlteDateinamen(1).List(i) = "x:\PERM\Abt_Sach-Breite\Vertragsgrundlagen\Maklerklauseln\10 G0 325 0_Jährliche Kündbarkeit.doc" Then
            WinWordProg.Selection.WholeStory
            WinWordProg.Selection.Find.ClearFormatting
            WinWordProg.Selection.Find.Replacement.ClearFormatting
            With WinWordProg.Selection.Find
                .Text = "Datum"
            End With
            WinWordProg.Selection.Find.Execute
            WinWordProg.Selection.Delete
            WinWordProg.Selection.TypeText Text:=Datum & " "
        End If

    WinWordProg.Selection.WholeStory
    'Markierung kopieren
    WinWordProg.Selection.Copy
    'Gesamtdokument aktivieren
    WinWordProg.application.Documents(lstAusgewaehlteDateinamen(1).List(0)).Activate
    'WinWordProg.application.Documents(DateiNeu).Activate
    'im Gesamtdokument alles markieren
    WinWordProg.Selection.WholeStory
    'an die richtige Stelle manövrieren
    WinWordProg.Selection.EndKey    'zuerst ganz ans Ende
    'den letzten Zeilenumbruch durch Backspacetaste löschen
    WinWordProg.Selection.MoveLeft
    WinWordProg.Selection.Delete
    'Zwischenablage einfügen
    WinWordProg.Selection.Paste
    'Teil-Dokument wieder schließen
    WinWordProg.application.Documents(lstAusgewaehlteDateinamen(1).List(i)).Close wddonotsafechanges

    End If
Next i

WinWordProg.application.Documents(lstAusgewaehlteDateinamen(1).List(0)).Activate

'Gesamtdokument drucken
For i = 1 To Druckanzahl
    WinWordProg.application.Documents(lstAusgewaehlteDateinamen(1).List(0)).printout
Next i
'Gesamtdokument speichern

CmDialog1.Flags = &H2&
CmDialog1.Filter = "Dateien (*.doc)|*.doc"
On Error GoTo NICHTSPEICHERN
CmDialog1.Action = 2
WinWordProg.application.Documents(lstAusgewaehlteDateinamen(1).List(0)).Activate
WinWordProg.application.activeDocument.SaveAs FileName:=CmDialog1.FileName, FileFormat:=wdFormatDocument, _
         LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False

NICHTSPEICHERN:

'Dokument wieder schließen
'winwordprog.Documents(lstAusgewaehlteDateinamen(1).List(0)).Close wddonotsafechanges
WinWordProg.application.activeDocument.Close wddonotsafechanges
Sleep 1000
WinWordProg.Visible = True
WinWordProg.application.Quit

txtPolizzennummer.Text = ""
txtDruckstatus.Visible = False
frmMakleranschrift.Visible = False
txtMakleranschrift.Text = ""
txtMakleranschrift.Visible = False

'Abschliessende Meldung
MsgBox "Ausgewählte Dokumente wurden gedruckt!", vbInformation

End Sub

Private Sub cmdLoeschen_Click()
ListIndex = lstAuswahl(m_iList).ListIndex
lstAuswahl(m_iList).RemoveItem lstAuswahl(m_iList).ListIndex
lstAusgewaehlteDateinamen(1).RemoveItem (ListIndex)
DruckEnabler
End Sub
Private Sub cmdSchliessen_Click()
Me.Hide
Unload Me
End Sub
Private Sub Form_Load()
    Shell ("NET USE X: \\At010000vf015\a0033d")
    Sleep 3000
    drvLaufwerk = "x:[At010000vf015\a0033d]"
'Fehlerroutine wenn X nicht verbunden werden konnte
'   If Left(drvLaufwerk, 22) <> "x: [\\At010000vf015\a0033d]" Then
'   GoTo Fehler
'   End If
    dirOrdner.Path = "x:\PERM\Abt_Sach-Breite\Vertragsgrundlagen\Maklerklauseln"
    fileQuelle = dirOrdner.Path
    Druckanzahl = "1"
'Exit Sub

'Fehler:
'    MsgBox ("Die Anwendung zum Druck der Maklerklauseln konnte nicht geöffnet werden!" & Chr(13) & _
'    "Bitte kontaktieren Sie Ihre RD-Betreuung Sach/Breite!"), vbCritical
'    Me.Hide
'    Unload Me
End Sub
Private Sub AddFileToList(listType As eType, sName As String, sNamePfad As String)
Dim lCounter As Long
Dim i As Integer


If UCase$(Right$(sName, 4)) <> ".DOC" Then
    MsgBox "Die Datei '" & sName & "' ist kein Word-Dokument." & vbCrLf & vbCrLf & "Nur Word-Dokumente können gedruckt werden!", vbInformation
    Exit Sub
End If

If UCase$(Left$(sName, 11)) = "10 G0 324 0" Or UCase$(Left$(sName, 11)) = "10 G0 325 0" Then
    Datum = InputBox("Geben Sie bitte das Datum der erstmaligen Kündigung im Format ''TT.MM.JJJJ'' ein!", "Eingabe Kündigungsdatum")
    If Not IsDate(Datum) Then
        MsgBox ("Es wurde kein oder ein falsches Datum eingegeben, daher konnte diese Besondere Bedingung nicht hinzugefügt werden!")
        Exit Sub
    End If

    Datum = Format(Datum, "dd.mm.yyyy")

End If

' verhindert doppelten Eintrag
For i = 0 To 0
    For lCounter = 0 To lstAuswahl(i).ListCount
      If UCase(lstAuswahl(i).List(lCounter)) = UCase(sName) Then Exit Sub
    Next
Next

' hinzufügen
lstAuswahl(listType).AddItem sName
lstAusgewaehlteDateinamen(1).AddItem sNamePfad

' Drucken enabled?
DruckEnabler

End Sub
Private Sub lstAuswahl_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
m_iList = Index
If Button = vbRightButton Then ShowContextMenu
End Sub
Private Sub ShowContextMenu()
If lstAuswahl(m_iList).SelCount > 0 Then
    mnuEntfernen.Enabled = True
Else
    mnuEntfernen.Enabled = False
End If

PopupMenu mnuPopMenu, vbPopupMenuRightButton
End Sub
Private Sub mnuEntfernen_Click()
ListIndex = lstAuswahl(m_iList).ListIndex
lstAuswahl(m_iList).RemoveItem lstAuswahl(m_iList).ListIndex
lstAusgewaehlteDateinamen(1).RemoveItem (ListIndex)
DruckEnabler
End Sub
Private Sub DruckEnabler()
Dim i As Integer

For i = 0 To 0
    If (lstAuswahl(i).ListCount > 0) Then
      cmdDruck.Enabled = True
      Exit Sub
    End If
Next i
cmdDruck.Enabled = False
End Sub
Private Sub Option1_Click()
Option2.Value = False
Option3.Value = False
Option4.Value = False
Druckanzahl = "1"
End Sub
Private Sub Option2_Click()
Option1.Value = False
Option3.Value = False
Option4.Value = False
Druckanzahl = "2"
End Sub
Private Sub Option3_Click()
Option1.Value = False
Option2.Value = False
Option4.Value = False
Druckanzahl = "3"
End Sub
Private Sub Option4_Click()
Option1.Value = False
Option2.Value = False
Option3.Value = False
Druckanzahl = "4"
End Sub

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:

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
VBA Problem mit Word 2010	20.10.2011 19:36:38	Mario
VBA Problem mit Word 2010	22.10.2011 01:42:09	Till
VBA Problem mit Word 2010	22.10.2011 11:04:36	Mario
VBA Problem mit Word 2010	22.10.2011 12:01:59	Till
VBA Problem mit Word 2010	22.10.2011 12:06:35	Mario