Supportnet Computer
Planet of Tech

Supportnet / Forum / Textverarbeitung

OLE MS-Word zu ERP Baan (über macro)





Frage

Hallo und guten Tag! Ich habe (ohne viel Wissen von MS-Word / marco) eine OLE-Verbindung zu Baan hergestellt. Dadurch werden Adressen aus Baan nach MS Word geholt und gleich formatiert. Wird viel benutzt. Funktioniert soweit auch gut. Habe allerdings noch 2 Unschönheiten. 1. Nach der Darstellung der Daten in MS Word ist der Curser weg - erst nach einem Klick mit der Maus erscheint er wieder. [b]Der Curser sollte aber gleich wieder da sein, damit man sofort weiterschreiben kann.[/b] 2. Nach dem Aufruf des Macros wird das Eingabefeld für die Kunden-Nr. gezeigt. Aber der Curser steht nicht in diesem Feld. Man muss erst reinklicken . [b]Der Curser (Fokus) sollte gleich im Eingabefeld stehen.[/b] Unten habe ich das macro angefügt. Vielen Dank im Voraus! Gruß, Stefan __________________________________________ Dim BaanObj As Object Dim B_DLL As String Dim B_Function As String Dim B_Func As String Dim B_Return As String Dim B_err As String Dim dll_bran As Variant 'zu Übergabergebende des Key für Baan-Tabelle Dim seq As String * 6 'zur Anpassung des Key an Baan, Begrenzung auf 6 Zeichen Dim seq_length As Single 'zur Anpassung des Key an Baan Dim dll_dsca As String 'Rückgabestring von Baan-dll an VBA Script Dim a As Long Dim b As Long Dim c As Long 'Dim x As Long (nicht für MS Word) 'Dim y As Long (nicht für MS Word) 'Private Sub CommandButton1_Click() Sub Main() ' Verbindung zu Baan IV herstellen wenn nicht aktiv If BaanObj Is Nothing Then Set BaanObj = CreateObject("Baan4.Application") End If 'zu adressierende DLL auf Baan-Seite B_DLL = "otccomdll0010" 'Kundenadresse HULO selektieren für MS Word 'Eingabe des zu suchenden Wertes '---------------------------------------------------------- seq = Mid(seq, 1, 6) seq = (InputBox$("Kunden-Nr. HULO eingeben", "Kundenadresse HULO aus BaanIV lesen")) seq_length = Len(seq) 'Länge ermitteln dll_bran = String((6 - seq_length), " ") & seq 'Eingabewert übergeben mit führenden Blanks '--------------------------------------------------------- 'aufzurufende Funktion innerhalb der DLL B_Function = "get.dscr(""" & dll_bran & """ )" 'Funktion starten (dyn.SQL wird initialisiert) BaanObj.ParseExecFunction B_DLL, B_Function 'einenSatz übertragen B_Func = "fetch.query.result()" 'Startzeile u. Spalte (nicht für MS Word) 'x = 2 'y = 1 ' 1.Ergebnis wird gelesen BaanObj.ParseExecFunction B_DLL, B_Func 'Abfrage auf Fehlercode B_Error = BaanObj.Error 'zuweisen des Rückgabewertes B_Return = BaanObj.Returnvalue dll_dsca = B_Return 'Auslesen der Schleifenbedingung B_err = Mid(dll_dsca, 298, 3) If B_err = "err" Then MsgBox ("Kunde bei Huttenlocher nicht gefunden!") 'BaanObj.Quit 'Verbindung zu Baan beenden 'Set BaanObj=Nothing 'Verbindung zu Baan beenden Else Selection.InsertAfter Mid(dll_dsca, 1, 35) 'N1 Einfügen der Returnvariable ' an Kurserposition -***noch offen!! Selection.InsertAfter Chr(13) If Mid(dll_dsca, 36, 30) <> " " Then Selection.InsertAfter Mid(dll_dsca, 36, 30) 'N2 Selection.InsertAfter Chr(13) End If Selection.InsertAfter Mid(dll_dsca, 66, 30) 'Str1 Selection.InsertAfter Chr(13) If Mid(dll_dsca, 96, 30) <> " " Then Selection.InsertAfter Mid(dll_dsca, 96, 30) 'Str2 Selection.InsertAfter Chr(13) End If Selection.InsertAfter Chr(13) 'ergibt eine Leerzeile vor Ort Selection.InsertAfter Mid(dll_dsca, 126, 30) 'PLZ+Ort1 Selection.InsertAfter Chr(13) If Mid(dll_dsca, 156, 30) <> " " Then Selection.InsertAfter Mid(dll_dsca, 156, 30) 'Ort2 Selection.InsertAfter Chr(13) End If If Mid(dll_dsca, 186, 30) <> "DEUTSCHLAND " Then Selection.InsertAfter Mid(dll_dsca, 186, 30) 'Land Selection.InsertAfter Chr(13) End If 'Selection.InsertAfter Chr(13) Selection.Collapse wdCollapseEnd 'Nach Übergabe der Daten Aufheben der Verbindung zu Baan BaanObj.Quit 'Verbindung zu Baan beenden Set BaanObj = Nothing 'Verbindung zu Baan beenden End If End Sub Sub Terminate() BaanObj.Quit 'Verbindung zu Baan beenden Set BaanObj = Nothing 'Verbindung zu Baan beenden End Sub Sub Initialize() Set BaanObj = CreateObject("Baan4.Application") End Sub [*][quote][sup][i]Admininfo: Thread verschoben. Bitte beachte [url=https://supportnet.de/groupfaqs/3][u]FAQ 2[/u][/url] für deine nächste Anfrage.[/i][/sup][/quote]

Antwort von



Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: