AW: PDF-File von Excel aus starten und ...
08.07.2005 12:16:45
Excel
Hallo nochmal!
Hab jetzt deinen Code abgeändert, so dass es für mich passt. Aber leider erhält das Excel-Fenster danach immer noch nicht den Fokus! Am Ende seh ich wieder nur Arcobat im Vordergrund ...
Schau doch bitte mal drüber, weiß nich worans liegt. :-(
Private Declare
Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" ( _
ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Private Declare
Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hWnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Private Declare
Function SetWindowPos Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Declare
Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare
Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)
Private Declare
Function GetWindowPlacement Lib "user32" ( _
ByVal hWnd As Long, _
ByRef lpwndpl As WINDOWPLACEMENT) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Const MAX_PATH = 260&
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const SW_MAX = 10&
Sub test()
Dim path As String
Dim leer As String
Dim myShell As Object
Dim strPath As String, strShortPath As String, strFile As String
Dim hWnd As Long, WinEst As WINDOWPLACEMENT
Dim lngrow
With ActiveSheet.Columns(20)
Set splitt = .Find("SplittFehler", LookIn:=xlValues, LookAt:=xlWhole)
n = 5
If Not splitt Is Nothing Then
firstAddress = splitt.Address
Do
With splitt.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
With splitt.Offset(0, -10).Interior
.ColorIndex = 40
.Pattern = xlSolid
' Suche und öffne Datei
Set fs = Application.FileSearch
path = "\\w71c-122623\Lw_d\Elast_Ordner\E090421_Bearbeitung\"
With fs
.LookIn = path
.SearchSubFolders = True
.Filename = splitt.Offset(0, -10).Value
If .Execute() > 0 Then
lngrow = ""
If lngrow < Cells(Range("J65536").End(xlUp).Row, 10) Then
Cells(Range("J65536").End(xlUp).Row + n, 10) = "Splitt-Fehler in Datei " & "'" & fs.Filename & "'" & " :"
Cells(Range("J65536").End(xlUp).Row + 1, 10) = "'" & " --> Fehlende Seiten: "
n = 2
End If
For i = 1 To .FoundFiles.Count
File = Chr(34) & .FoundFiles(i) & Chr(34)
ShellExecute FindWindow("XLMAIN", vbNullString), "open", File, "", "", SW_MAX
Do
Sleep 100
hWnd = FindWindow("AdobeAcrobat", vbNullString)
If hWnd <> 0 Then GetWindowPlacement hWnd, WinEst
Debug.Print WinEst.showCmd
If WinEst.showCmd = 3 Then Exit Do
Loop
SetWindowPos FindWindow("XLMAIN", vbNullString), HWND_TOPMOST, _
0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
SetWindowPos FindWindow("XLMAIN", vbNullString), HWND_NOTOPMOST, _
0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
Next i
Else
MsgBox "There were no files found."
End If
End With
End With
Set splitt = .FindNext(splitt)
Loop While Not splitt Is Nothing And splitt.Address <> firstAddress
End If
End With
End Sub