3.5k Aufrufe
Gefragt in Tabellenkalkulation von fedjo Experte (2.2k Punkte)
Hallo Excelfreunde,
wie bringe ich eine geöffnete Excel- Datei mit VBS in den Vordergrund?

Mit Set xlApp = GetObject(, "Excel.Application")
xlApp.visible = True
kommt die Datei nicht in den Vordergrund.

Vielleicht habt ihr eine Lösung.
Gruß
fedjo

16 Antworten

0 Punkte
Beantwortet von
wird denn überhaupt ein Wert in die Variable hwnd geschrieben? Hier
handelt es sich um eine eindeutige Fenster-ID die Windows dem
Excel-Fenster beim Start zugewiesen hat. Falls nicht, probiers mal mit
XLMAIN in Großbuchstaben. Sollte eigentlich nicht das Problem sein,
aber ich halte mittlerweile Alles für möglich.
0 Punkte
Beantwortet von fedjo Experte (2.2k Punkte)
Set xlApp = GetObject(, "Excel.Application")
hWnd = FindWindow("XLMAIN", 0)
SendMessage(hWnd, 1042, 0, 0)
xlApp.visible = True
xlApp.Workbooks("MA2016.xlsm").Activate

Fehler:
Zeile3
Zeichen 30
Fehler: Beim Aufrufen einer Unterroutine (Sub)
Dürfen keine Klammern verwendet werden
Code: 800A0414
Quelle: Kompilierungsfehler in Microsoft VBScript
0 Punkte
Beantwortet von
Soweit waren wir schon in Antwort 4. Aber wie lautet der Fehler, wenn
du die Klammern, wie gewünscht, einfach weglässt? Oder wenn du
aus der Sub wieder eine Funktion machst, indem du davor noch x =
schreibst? Was dann nach x zurückgegeben wird ist egal. Meist ist das
ein Wahrheitswert, der angiebt, ob die Funktion erfolgreich war.

Ob was in hwnd steht, kannst du bestimmt auch mit msgbox hwnd
testweise auslesen. Solange nicht eindeutig klar ist, ob die Api-
Funktionen bei dir im SAP nun funktionieren oder nicht, kann ich dir
leider nicht weiterhelfen.
0 Punkte
Beantwortet von
Hallo Fedjo,

falls es wirklich nur an SendMessage liegen sollte, die API-Funktionen als solche aber funktionieren hier noch eine letzte Alternative um Send Message und GetObject zu umgehen. Die Wahrscheinlichkeit, dass diese funktioniert ist extrem gering. Es gibt viele Versionsbedingte Wenns und Abers, die nicht zuletzt auch auf die aufs nötigste runtergebrochenen Befehle zurückführen. In meinem Testzugriff aus Word 2000 unter Windows-Vista klappts. Sollte es bei dir nicht klappen, ignoriere bitte diese Antwort und versuche weiterhin den üblichen Weg über GetObject, wie beschrieben.

Hier der Code zum ausprobieren:
'Windows Api Funktionen
Declare Function GetDesktopID Lib "user32" Alias "GetDesktopWindow" () As Long
Declare Function FindID Lib "user32" Alias "EnumChildWindows" (ByVal hwndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function getwindowtext Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpstring As String, ByVal cch As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function GetxlObject Lib "oleacc" Alias "AccessibleObjectFromWindow" (ByVal hwnd As Long, ByVal dwid As Long, ByRef riid As apiuuid, ByRef ppvobject As Object) As Long
Declare Function Getapiuuid Lib "ole32" Alias "IIDFromString" (ByVal lpsz As Long, lpiid As apiuuid) As Long

'Globale Variablen
Dim wbID As Long
Dim wbName As String

Type apiuuid
a As Long
b As Integer
c As Integer
d(7) As Byte
End Type

Sub test19()

wbName = "MA2016.xlsm"
a = FindID(GetDesktopID, AddressOf FindWbID, 0)
Set wb = GetWb(wbName)

'ab hier dein WbZugriff
wb.Application.Visible = True
wb.Activate
wb.ActiveSheet.Range("A1").PasteSpecial -4163 'zahl steht für xlPastevalues

End Sub
Private Function FindWbID(ByVal Handle As Long, ByVal Params As Long) As Long
Dim t As String, c As String
On Error Resume Next
t = String(255, " ")
d = getwindowtext(Handle, t, 255)
c = String(255, " ")
b = GetClassName(Handle, c, 255)
If InStr(1, LCase(t), LCase(wbName)) > 0 And InStr(1, UCase(c), "EXCEL") > 0 Then
wbID = Handle
FindWbID = False
Else
FindWbID = True
End If
End Function

Private Function GetWb(xlWbName) As Object

Dim wd As Object, a As Long, uuid As apiuuid
Dim key As String

key = "{00020400-0000-0000-C000-000000000046}"

a = Getapiuuid(StrPtr(key), uuid)
a = GetxlObject(wbID, &HFFFFFFF0, uuid, wd)

Set GetWb = wd.Application.workbooks(xlWbName)

End Function

Gruß Mr. K.
0 Punkte
Beantwortet von
uups, Sorry für das Bildformat. Hab nicht dran gedacht, dass die API-Funktionen so lang sind.
Sehe grad noch, dass ich ein paar Variablen noch nicht dimensioniert hatte.

In Test 19: Dim a As Long, wb As Object
In FindWbId: Dim d As Long, b As Long
0 Punkte
Beantwortet von fedjo Experte (2.2k Punkte)
Hallo Mr. K.,
Danke noch mal, dass Du Dich um mein Problem lange bemüht hast.
Ich werde jetzt damit abschließen, da es ja doch nicht so einfach ist,
und in der Arbeit auch noch andere Systemvoraussetzungen (Windows7, Excel 2013)
habe.

Danke
Schönes Wochenende
Gruß
fedjo
...