Excel Vba Problem Mit Office 2010

Computer: Software & Programmierung Visual Basic
#1

Liebe/-r Experte/-in,

ich habe in Excel (97) Vba eine Anwendung programmiert, die auf Knopfdruck ein Wordformular öffnet und die Daten in das Word überträgt.

Die Programmierung sieht so aus:

Sub FahrkostenBKKoelnnachWord()
Rem variablen vereinbaren
Dim worddatei As Object
Dim testdatei As Object
Rem physische datei zuordnen
Set worddatei = CreateObject(„word.application“)
Set testdatei = worddatei.documents.Add("\s1000fs001\BG_AG\BG_AG_BGSYS\Dateien\fahrtkosten1.dot")
Rem datei öffnen
worddatei.Visible = True
testdatei.Activate
Rem zellinhalte übertragen
testdatei.bookmarks(„Textmarke2“).Range.Text = Range(„a13“)
testdatei.bookmarks(„Textmarke3“).Range.Text = Range(„a14“)
testdatei.bookmarks(„Textmarke4“).Range.Text = Range(„a15“)
testdatei.bookmarks(„Textmarke5“).Range.Text = Range(„b18“)
testdatei.bookmarks(„Textmarke6“).Range.Text = Range(„b21“)
testdatei.bookmarks(„Textmarke7“).Range.Text = Range(„b33“)
testdatei.bookmarks(„Textmarke8“).Range.Text = Range(„b32“)
testdatei.bookmarks(„Textmarke9“).Range.Text = Range(„a13“)

Rem zu übertragenden wert verarbeiten
wert = Str(Round(Range(„b35“), 2))
If InStr(wert, „.“) = 0 Then
wert = wert + „,00 EUR“
Else
If InStr(wert, „.“) = Len(wert) - 1 Then
wert = wert + „0 EUR“
Else
wert = wert + „EUR“
End If
End If
testdatei.bookmarks(„textmarke10“).Range = wert

Rem wert übertragen
wert = Str(Round(Range(„b37“), 2))
If InStr(wert, „.“) = 0 Then
wert = wert + „,00 EUR“
Else
If InStr(wert, „.“) = Len(wert) - 1 Then
wert = wert + „0 EUR“
Else
wert = wert + „EUR“
End If
End If
testdatei.bookmarks(„textmarke11“).Range = wert

Rem wert übertragen
wert = Str(Round(Range(„b38“), 2))
If InStr(wert, „.“) = 0 Then
wert = wert + „,00 EUR“
Else
If InStr(wert, „.“) = Len(wert) - 1 Then
wert = wert + „0 EUR“
Else
wert = wert + „EUR“
End If
End If
testdatei.bookmarks(„textmarke12“).Range = wert

Rem wert übertragen
wert = Str(Round(Range(„b40“), 2))
If InStr(wert, „.“) = 0 Then
wert = wert + „,00 EUR“
Else
If InStr(wert, „.“) = Len(wert) - 1 Then
wert = wert + „0 EUR“
Else
wert = wert + „EUR“
End If
End If
testdatei.bookmarks(„textmarke13“).Range = wert

testdatei.bookmarks(„Textmarke14“).Range.Text = Range(„b23“)
testdatei.bookmarks(„Textmarke15“).Range.Text = Range(„b27“)
testdatei.bookmarks(„Textmarke16“).Range.Text = Range(„b24“)

End Sub

Nach dem Umstieg auf Office 2010 funktioniert diese Übertragung nicht mehr.

Ich habe bereits gegoogelt und gesehen, dass irgendwo eine Verzögerung eingebaut werden soll, aber ich bekomme es nicht hin.

Wie und an welcher Stelle müsste das eingefügt werden?

Vielen lieben Dank

Andreas Scherber

#2

Hallo Andreas,

ich glaube nicht, dass es an irgendwelchen Verzögerungen liegt, von denen ich noch nichts gehört hbe. Ich glaube, dass er die Daie .dot unter 2010 nicht findet. Speichere die Vorlage mal unter .dotx (also in 2010!) ab, ändere die Programmzeiele und es müßte gehen.

Wenn nicht, schreibe noch mal. Bin heute ziemlich lang am Rechner und kann dann helfen!

Grüße aus Nürnberg

Jürgen

#3

Hallo Andreas,

ich muss wissen, welcher Fehler (Nr) auftritt.
Habe es bei mir probiert und keinen Fehler erhalten.

Gruß nach einem Weihnachtsurlaub
Reinhold

#4

Hallo Reinhold,

vielen Dank für die Beantwortung zunächst.

Ich habe noch mal experimentiert und es geht jetzt. Es traut ein Laufzeitfehler auf.

Ich habe nun nach der createobject zeile über application.wait eine 1 Sekundenverzögerung eingebaut und es klappt wieder.

Gruß
Andreas

#5

Hallo Andreas,

ich war im Urlaub, also verzeih bitte die späte Antwort.

Soweit ich das sehe, ist alles richtig und sollte auch unter 2007 und 2010 laufen…btw: was bedeutet in diesem Zusammenhang ‚unktioniert diese Übertragung nicht mehr‘ genau?

Ich habe einen kleinen Testlauf mit 2007 gemacht…läuft einwandfrei, auch wenn der Code an einigen Stellen etwas umständlich geschrieben ist

Heute Abend habe ich wieder Zugriff auf ein OFFICE 2010, dann sehe ich es genau und gebe morgen ein feedback.

LG,
Burkhard

#6

Hallo Andreas,

nu ist es passiert *G*, ich hab es mit Office 2010 getestet und es hat einwandfrei funktioniert.
Wenn es bei euch nicht funktioniert, kommen nur 3 Fehlerquellen in Frage

  1. Einer der zu formatierenden Werte (b35, b37, b38 und/oder b40) ist keine erkennbare Zahl (punkt statt komma / O(Oh) statt 0(null) /…) oder

  2. Die Zeile

    Set testdatei = worddatei.documents.Add("\s1000fs001\BG_AG\BG_AG_BGSYS\Dateien\fahrtkosten1.dot")

verweist auf eine falsche oder keine ‚*.dot‘ oder

  1. Du hast ein Rechteproblem… dann müesste ich aber wissen, an welcher Stelle der Code aussteigt.

Und, damit Du siehst, das ich mir das wirklich angeschaut habe, habe ich Deinen Code mal ‚etwas zerpflückt‘, meint: wiederkehrende Schritte ausgelagert und somit die pflegbarkeit und eine Fehlersuche erleichtert :

Sub FahrkostenBKKoelnnachWord()
 ' variablen vereinbaren
 Dim worddatei As Object
 Dim testdatei As Object

 ' physische datei zuordnen
 Set worddatei = CreateObject("word.application")
 Set testdatei = worddatei.documents.Add("\\s1000fs001\BG\_AG\BG\_AG\_BGSYS\Dateien\fahrtkosten1.dot", , , True)

 ' datei sichtbar machen
 worddatei.Visible = True

 'nicht nötig, aber OK
 testdatei.Activate

 ' Zellinhalte 1 zu 1 übertragen
 testdatei.bookmarks("Textmarke2").Range.Text = Range("a13")
 testdatei.bookmarks("Textmarke3").Range.Text = Range("a14")
 testdatei.bookmarks("Textmarke4").Range.Text = Range("a15")
 testdatei.bookmarks("Textmarke5").Range.Text = Range("b18")
 testdatei.bookmarks("Textmarke6").Range.Text = Range("b21")
 testdatei.bookmarks("Textmarke7").Range.Text = Range("b33")
 testdatei.bookmarks("Textmarke8").Range.Text = Range("b32")
 testdatei.bookmarks("Textmarke9").Range.Text = Range("a13")
 testdatei.bookmarks("Textmarke14").Range.Text = Range("b23")
 testdatei.bookmarks("Textmarke15").Range.Text = Range("b27")
 testdatei.bookmarks("Textmarke16").Range.Text = Range("b24")

 ' zu formatierende Daten
 Call addValue("b35", "textmarke10", testdatei)
 Call addValue("b37", "textmarke11", testdatei)
 Call addValue("b38", "textmarke12", testdatei)
 Call addValue("b40", "textmarke13", testdatei)
End Sub

Sub addValue(myCell As String, textmarke As String, target As Object)
 ' Formatiert übergeben Werte aus Zelle 'myCell'
 ' und trägt diese im Dokumentobject 'target'
 ' in die Textmarke 'textmarke' ein
 Dim wert As String

 wert = Str(Round(Range(myCell), 2))
 If InStr(wert, ".") = 0 Then
 wert = wert + ",00 EUR"
 Else
 If InStr(wert, ".") = Len(wert) - 1 Then
 wert = wert + "0 EUR"
 Else
 wert = wert + " EUR"
 End If
 End If
 target.bookmarks(textmarke).Range = wert
End Sub

Wenn das bei Dir also nicht funktioniert, schick mir bitte Zeile in der den Code aussteigt und, wenn möglich, den Fehlercode.

Wie auch immer, gib bitte ein kurzes feadback, damit ich mich nicht mit einem Problem beschäftige, das inzwischen gelöst ist *G*

LG,
Burkhard

#7

Hi Burkhard,

es hakte in der Zeile in der createobject vorkam. Ich habe noch mal experimentiert und das Problem ist gelöst durch eine apllication.wait Verzögerung von 1 Sekunde.

Frag mich nicht warum, aber es funktioniert.

Tausend Dank aber für Deine Mühe - auf die Leute hier ist echt Verlaß.

Danke
Andreas

#8

Hallo Andreas,

schön, das es funktioniert, aber ich finde eine Lösung mit einem Wartezyklus immer etwas unglücklich, da Du im Vorfeld festlegen musst, wie lange Du warten willst….
So wie Dein Code aufgebaut ist, ziehst Du die *dot von einem Netzlaufwerk, Du musst also hoffen, das Deine Sekunde immer ausreicht … sonst knallt es wieder, wenn Dein Netzwerk gerade mal einen schlechten Tag hat :smile:

Du kannst stattdessen auch ein DoEvents eintragen, dann wartet Dein Code mit der Ausführung, bis Word den Vollzug meldet…
Wenn es mit DoEvents einmal funktioniert, funktioniert es immer … ach ja, eine kleine Fehlerroutine schadet auch nichts :smile:)

Beispiel :

Sub FahrkostenBKKoelnnachWord()
 ' variablen vereinbaren
 Dim worddatei As Object
 Dim testdatei As Object

 ' ab jetzt im Fehlerfall zur Marke ups1
 On Error GoTo ups1
 Set worddatei = CreateObject("word.application")

 ' Warten auf Word
 DoEvents

 ' ab jetzt im Fehlerfall zur Marke ups2
 On Error GoTo ups2

 ' neuer Wordinstanz das DOT zuweisen
 Set testdatei = worddatei.documents.Add("\\s1000fs001\BG\_AG\BG\_AG\_BGSYS\Dateien\fahrtkosten1.dot", , , True)

 ' Wenn ab hier ein Fehler auftaucht, wieder die normale Fehlerbehandlung
 On Error GoTo 0

 ' datei sichtbar machen
 worddatei.Visible = True

 ' Zellinhalte 1 zu 1 übertragen
 testdatei.bookmarks("Textmarke2").Range.Text = Range("a13")
 testdatei.bookmarks("Textmarke3").Range.Text = Range("a14")
 testdatei.bookmarks("Textmarke4").Range.Text = Range("a15")
 testdatei.bookmarks("Textmarke5").Range.Text = Range("b18")
 testdatei.bookmarks("Textmarke6").Range.Text = Range("b21")
 testdatei.bookmarks("Textmarke7").Range.Text = Range("b33")
 testdatei.bookmarks("Textmarke8").Range.Text = Range("b32")
 testdatei.bookmarks("Textmarke9").Range.Text = Range("a13")
 testdatei.bookmarks("Textmarke14").Range.Text = Range("b23")
 testdatei.bookmarks("Textmarke15").Range.Text = Range("b27")
 testdatei.bookmarks("Textmarke16").Range.Text = Range("b24")

 ' zu formatierende Daten
 Call addValue("b35", "textmarke10", testdatei)
 Call addValue("b37", "textmarke11", testdatei)
 Call addValue("b38", "textmarke12", testdatei)
 Call addValue("b40", "textmarke13", testdatei)
 Exit Sub

ups1:
 On Error GoTo 0
 a = MsgBox("Netzerkzugriff auf Word ohne Erfolg", vbCritical, "Dateifehler")
 Exit Sub

ups2:
 On Error GoTo 0
 a = MsgBox("Netzerkzugriff auf Formatvorlagedatei ohne Erfolg", vbCritical, "Dateifehler")
 Exit Sub

End Sub

Sub addValue(myCell As String, textmarke As String, target As Object)
 ' Formatiert uebergebene Werte aus Zelle 'myCell'
 ' und traegt diese im Dokumentobject 'target'
 ' in die Textmarke 'textmarke' ein
 Dim wert As String

 wert = Str(Round(Range(myCell), 2))
 If InStr(wert, ".") = 0 Then
 wert = wert + ",00 EUR"
 Else
 If InStr(wert, ".") = Len(wert) - 1 Then
 wert = wert + "0 EUR"
 Else
 wert = wert + " EUR"
 End If
 End If
 target.bookmarks(textmarke).Range = wert
End Sub
#9

Hallo Burkhard,

ich habe das gerade mal ausprobiert mit Event … sehr geniale Lösung. Tausend Dank!!!

Gruß
Andreas