Hallo TP !!
Vielen Dank für Deine Antwort !!
Ja das hat schon was, wie soll denn excel gescheit ins word schreiben, wenn keine Instanz existiert...wie ungeschickt von mir :-)
Daraus ergibt sich für mich folgende Fragen:
1.Wie kann ich von Excel aus so eine Instanz erzguen, damit mir Excel nicht abstürzt
2. Fehlermeldungen kann man ja mit "on error resume next" abfangen, wie steht es aber umd Laufzeitfehler ? ich krieg dann meistens einen Laufzeitfehler '429' und wenn ich aber nach 429 abfrage mit:
if err = "429", dann klappt das nicht so ganz... wo liegt das Problem ?
Komischer weise ist es so, dass ich ein userform frmhaupt habe und von dort aus das wordokument über die Routine (siehe unten) erstellen lasse, sobald ich den entsprechenden button betätige. Ich war irgendwie der meinung, dass ich bis zu dem Zeitpunkt, wo ich den button betätige word so oft öffnen und schliessen kann wie ich möchte, dem ist aber nicht so, owohl da das wordobjekt erst nach betätigung des buttons erstellt wird... hmmm was mach ich denn da schon wieder für einen Denkfehler ? :-)
Hier noch der Code:
Private Sub erstellenwordangebot()
Dim intzeile As Integer
Dim rngusedrange As Range
Dim wksworksheet As Worksheet
Dim lngrows As Long
Dim wdapp As Word.Application
Dim wdDatei As Word.Document
Dim intZeilen As Integer
Dim intZähler As Integer
Dim xlZelle As Range
Dim strpfadmerker As String
Dim pseudomerker As Integer
' ermitteln des letzten Eintrags zur Bestimmung der neuen Angebotsnummer
Set wksworksheet = ThisWorkbook.Worksheets("Angebotsnummern")
Set rngusedrange = wksworksheet.UsedRange
lngrows = rngusedrange.Rows.Count
' On Error Resume Next
Set wdapp = Word.Application
wdapp.Visible = True
strpfadmerker = wdapp.Options.DefaultFilePath(Path:=wdUserTemplatesPath)
'Festlegen des Vorlagenordners
wdapp.Options.DefaultFilePath(Path:=wdUserTemplatesPath) = _
Worksheets("Allgemein").Range("A31").Value
If Worksheets("Angebotsnummern").Range("AA" & lngrows) = "fax" Then
Set wdDatei = Word.Documents.Add("Vorlage_Angebot.dot")
ElseIf Worksheets("Angebotsnummern").Range("AA" & lngrows) = "mail" Then
Set wdDatei = Word.Documents.Add("Vorlage_Angebot-email.dot")
Else
MsgBox ("Es wurde für die Angeobtsausgabe weder Fax noch mail definiert" & Chr(10) & "Standardauswahl: FAX")
Set wdDatei = Word.Documents.Add("Vorlage_Angebot.dot")
End If
With wdapp
With .Selection
.Goto what:=wdGoToBookmark, Name:="firma"
.TypeText Text:=txtfirma
.Goto what:=wdGoToBookmark, Name:="plz"
.TypeText Text:=txtplz
.Goto what:=wdGoToBookmark, Name:="ort"
.TypeText Text:=txtort
.Goto what:=wdGoToBookmark, Name:="name"
.TypeText Text:=txtname
.Goto what:=wdGoToBookmark, Name:="vorname"
.TypeText Text:=txtvorname
.Goto what:=wdGoToBookmark, Name:="anrede"
.TypeText Text:=cboanrede.Value
.Goto what:=wdGoToBookmark, Name:="namecoolson"
.TypeText Text:=txtname_coolson
.Goto what:=wdGoToBookmark, Name:="mail"
.TypeText Text:=txtmail
.Goto what:=wdGoToBookmark, Name:="seiten"
.TypeText Text:=txtseitenzahl
.Goto what:=wdGoToBookmark, Name:="datum"
.TypeText Text:=txtdatum
.Goto what:=wdGoToBookmark, Name:="zeit"
.TypeText Text:=txtzeit
.Goto what:=wdGoToBookmark, Name:="projektname"
.TypeText Text:=txtbetreff
.Goto what:=wdGoToBookmark, Name:="angebotsnummer"
.TypeText Text:=txtangebotsnummer
.Goto what:=wdGoToBookmark, Name:="kopfanrede"
.TypeText Text:=cboanrede.Value
.Goto what:=wdGoToBookmark, Name:="kopfname"
.TypeText Text:=txtname
.Goto what:=wdGoToBookmark, Name:="kurs"
.TypeText Text:=txtkurs
.Goto what:=wdGoToBookmark, Name:="lieferzeit"
.TypeText Text:=cbolieferzeit.Value
.Goto what:=wdGoToBookmark, Name:="lieferung"
.TypeText Text:=cbolieferung.Value
.Goto what:=wdGoToBookmark, Name:="angebotsgueltigkeit"
.TypeText Text:=cboangeobtsgültigkeit.Value
.Goto what:=wdGoToBookmark, Name:="verfassername"
.TypeText Text:=txtname_coolson
End With
End With
wdapp.ChangeFileOpenDirectory (Worksheets("Allgemein").Range("A32").Value)
wdDatei.SaveAs (txtangebotsnummer)
wdapp.Options.DefaultFilePath(Path:=wdUserTemplatesPath) = strpfadmerker
Set wdapp = Nothing
Set wdDatei = Nothing
Set xlZelle = Nothing
' ermitteln des letzten Eintrags zur Bestimmung der neuen Angebotsnummer
Set wksworksheet = ThisWorkbook.Worksheets("Angebotsnummern")
Set rngusedrange = wksworksheet.UsedRange
lngrows = rngusedrange.Rows.Count
Worksheets("Angebotsnummern").Range("Z" & CStr(lngrows)) = "erstellt"
pseudomerker = MsgBox("Worddokument erstellt. Bitte Sowohl Anwendung als auch Excel schliessen", vbInformation + vbOKOnly, "Mitteilung")
End Sub
Gruss vom VBA-Neuling
Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP