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]