Private
Const
WM_KILLFOCUS = &H8
Private
Const
WM_SETFOCUS = &H7
Private
Declare
PtrSafe
Function
SendMessage
Lib
"user32"
Alias
"SendMessageA"
_
(
ByVal
hwnd
As
LongPtr,
ByVal
wMsg
As
Long
,
ByVal
wParam
As
Long
, lParam
As
Any)
As
Long
Private
Declare
PtrSafe
Function
SetWindowPos
Lib
"user32"
_
(
ByVal
hwnd
As
LongPtr,
ByVal
hWndInsertAfter
As
LongPtr,
ByVal
x
As
Long
,
ByVal
y
As
Long
, _
ByVal
cx
As
Long
,
ByVal
cy
As
Long
,
ByVal
wFlags
As
Long
)
As
Long
Sub
ExcelAnzeigen()
ExtDateipfad =
"D:\Daten\Entwicklung\Tests\Test.xlsm"
Tabellenname =
"Tabelle1"
On
Error
Resume
Next
Set
ExcApp = CreateObject(
"Excel.Application"
)
On
Error
GoTo
0
wdhwnd = Application.ActiveWindow.hwnd
Set
excwb2 = ExcApp.Workbooks.Open(ExtDateipfad)
Set
ExcWs2 = excwb2.Sheets(Tabellenname)
excwb2.Activate
ExcApp.Visible =
True
ExcApp.WindowState = -4137
ExcWs2.Activate
ExcWs2.Visible =
True
ExcWs2.Cells(ExcWs2.Cells(ExcWs2.Rows.Count, 1).
End
(-4162).Row, 1).
Select
Set
rng = ExcApp.Selection
Do
DoEvents
Loop
Until
ExcApp.Selection.Address <> rng.Address
Debug.Print ExcApp.Selection.Address
Debug.Print rng.Address
Exchwnd = ExcApp.ActiveWindow.hwnd
a = SetWindowPos(Exchwnd, 1, 0, 0, 1000, 1000, 0)
b = SendMessage(Exchwnd, WM_KILLFOCUS, 0&, 0&)
c = SendMessage(wdhwnd, WM_SETFOCUS, 0&, 0&)
Application.ActiveWindow.Activate
ThisDocument.Activate
With
excwb2
.Saved =
True
.Close
End
With
ExcApp.Quit
Set
excwb2 =
Nothing
End
Sub