Fermer un fichier PDF via VBA

[mister fish]

Bonjour à tous
Je sollicite votre aide car j'ai encore besoin de vos lumières
Voici mon problème, sur Excel je génère un fichier PDF via le code
suivant

ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
Imprimante_AdobePDF, Collate:=True

La variable Imprimante_AdobePDF étant définie plus haut

Mon problème est que je dois fermer ce fichier PDF et revenir sur mon
fichier Excel pour continuer à exécuter ma macro, et la je bloque....

Pour info je suis sur Excel 2003

Merci de votre aide

[MichD]

Bonjour,

Dans le classeur où l'action se déroule,

Dans un module standard de ce classeur,

Dans ta macro, utilise une variable en début de procédure pour identifier le classeur ouvert
qui doit être actif après l'impression et la fermeture de ton fichier PDF.

Dim Wk As Workbook

Set Wk = Workbooks("Nom_Du_Classeur.xlsm")

'à titre d'exemple, pour fermer Acrobat Reader, tu devrais passer la ligne de commande suivante :
call Fermer_Un_Programme(AcroRd32.exe)
Cette ligne de code ferme l'application, mais ne demande jamais de sauvegarder le travail le cas échéant.

AcroRd32.exe représente l'exécutable de l'application. Si tu n'es pas sûr du nom, tu peux regarder
dans la fenêtre du gestionnaire de tâches. Raccourci clavier : Ctrl + alt + Del

et tu termine par ceci pour t'assurer que c'est le bon classeur qui devient la fenêtre active.
Wk.Activate


Tu colles cette procédure dans un module standard.
'-----------------------------------
Sub Fermer_Un_Programme(Prog As String)
Dim StrComputer As String, objWMIService As Object
StrComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & StrComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '" & Prog & "'")
For Each objProcess In colProcessList
objProcess.Terminate
Next

End Sub
'-----------------------------------


MichD
------------------------------------------

[julien_...@hotmail.com]

Bonjour MichD
Merci pour ton retour
Il semble que l'executable de l'application soit acrobat.exe
Mais aprés avoir tester ce code

Sub test()
Dim Wk As Workbook

Set Wk = Workbooks("julien.xls")

ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
Imprimante_AdobePDF, Collate:=True

Call Fermer_Un_Programme(Acrobat.exe)
Wk.Activate
End Sub

Sub Fermer_Un_Programme(Prog As String)
Dim StrComputer As String, objWMIService As Object
StrComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & StrComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = '" & Prog & "'")
For Each objProcess In colProcessList
objProcess.Terminate
Next
End Sub

la macro bloque sur la ligne
Call Fermer_Un_Programme(Acrobat.exe)

et je comprends pas pourquoi
si tu as une idée je suis preneur
Merci

[MichD]

Désolé, j'ai oublié dans mon exemple de mettre le paramètre en guillemets
comme ceci :


Call Fermer_Un_Programme("Acrobat.exe")

MichD
------------------------------------------

[julien_...@hotmail.com]

Merci
Cela fonctionne parfaitement
Du coup j'ai une question subsidiaire
Existe t il une solution pour reduire la fenetre PDF ?
Merci encore pour ton aide

[MichD]

Colle tout ce qui suit dans un module standard et exécute la procédure test()


Option Explicit

' Module Name: ModFindWindowLike
' (c) 2005 Wayne Phillips (http://www.everythingaccess.com)
' Written 02/06/2005

Private Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long

Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long

Private Declare Function GetWindowModuleFileName Lib "user32" _
Alias "GetWindowModuleFileNameA" (ByVal hwnd As Long, _
ByVal Filename As String, ByVal cch As Long) As Long

Private Declare Function ShowWindow& Lib "user32" _
(ByVal hwnd As Long, ByVal ncmdshow As Long)

Public Const SW_MINIMIZE = 6

'Custom structure for passing in the parameters in/out of the hook enumeration function
'Could use global variables instead, but this is nicer.
Private Type FindWindowParameters

strTitle As String 'INPUT
hwnd As Long 'OUTPUT

End Type
'-------------------------------------------------------------
Public Function FnFindWindowLike(strWindowTitle As String) As Long

'We'll pass a custom structure in as the parameter to store our result...
Dim Parameters As FindWindowParameters
Parameters.strTitle = strWindowTitle ' Input parameter

Call EnumWindows(AddressOf EnumWindowProc, VarPtr(Parameters))

FnFindWindowLike = Parameters.hwnd

End Function
'-------------------------------------------------------------
Private Function EnumWindowProc(ByVal hwnd As Long, _
lParam As FindWindowParameters) As Long
Static x
Dim strWindowTitle As String

strWindowTitle = Space(260)
Call GetWindowText(hwnd, strWindowTitle, 260)
strWindowTitle = TrimNull(strWindowTitle) ' Remove extra null terminator

'If strWindowTitle <> "" Then
If strWindowTitle Like "*.pdf*" Or _
strWindowTitle Like "*acrobat" Then
Debug.Print strWindowTitle

lParam.hwnd = hwnd 'Store the result for later.
EnumWindowProc = 0 'This will stop enumerating more windows
End If
EnumWindowProc = 1

End Function
'-------------------------------------------------------------
Private Function TrimNull(strNullTerminatedString As String)
Dim lngPos As Long

'Remove unnecessary null terminator
lngPos = InStr(strNullTerminatedString, Chr$(0))

If lngPos Then
TrimNull = Left$(strNullTerminatedString, lngPos - 1)
Else
TrimNull = strNullTerminatedString
End If

End Function
'-------------------------------------------------------------
Sub test()

Dim MyAppHWnd As Long, File As String

MyAppHWnd = FnFindWindowLike("*Acrobat")
If MyAppHWnd > 0 Then
File = String$(1024, 0)
GetWindowModuleFileName MyAppHWnd, File, Len(File)
ShowWindow MyAppHWnd, SW_MINIMIZE
End If
End Sub
'-------------------------------------------------------------



--
MichD
---------------------------------------------------------------