Ouverture de fichiers extérieurs à Excel à partir d'une userform excel?

Version imprimable

Voir 40 message(s) de cette discussion en une page

15/12/2008, 16h50
dumpill

Une fois.
15/12/2008, 16h56
pgz

Alors je sèche.

PGZ
15/12/2008, 17h06
dumpill

Si par hazard j'avais dis "Deux fois"(même si ce n'est pas le cas).....c'est que tu avais une idée?
15/12/2008, 17h47
pgz

Citation:

Envoyé par dumpill

Si par hazard j'avais dis "Deux fois"(même si ce n'est pas le cas).....c'est que tu avais une idée?

Si en cliquant sur 2 assemblages on ouvrait 2 applications, alors, à mon avis :
- soit ce serait inhérent à l'applicatif
- soit ce serait une option à positionner correctement.

Mais ce n'est pas le cas. Donc une application ouverte peut supporter plusieurs documents, et les supporte effectivement.

L'ouverture avec Shell appelle à chaque fois le .exe. Donc pas trop étonnant que tu obtiennes plusieurs instances de l'appli.

Mais ce n'est pas le cas de ShellExecute et tu as le même résultat. En plus quand tu lances un seul fichier :

Citation:

Cette méthode ouvre bien mon fichier assemblage cependant elle l’ouvre deux fois (dont une fois en lecture seule)

Ce qui est encore pire. Au fait quand tu lances 2 fichiers, tu en a 3 ou 4?
Alors je sèche.

Peut-être un truc genre complexe pétrochimique, une usine à gaz hérissée d'antennes : en appelant l'explorateur et en cliquant avec des API, mais ça devient un boulot à plein temps pour un weekend...
16/12/2008, 08h12
dumpill

Bonjour PGZ
Quand je lance la macro pour deux fichiers différents, je me retrouve avec deux fois le même dont un en lecture seule et ceci dans le même « .exe ».
Le deuxième fichier qu’on lui a demandé d’ouvrir à dût passer à la trappe car il n’y en à aucune trace.

Sinon j’ai remarqué une chose qui ne me parait pas très « logique » avec le code que l’on m’a donné sur un autre forum. Il ouvre bien mes fichiers (certes dans deux .exe différents) et je n’ai aucun problème de mise à jour ou de relation quand ils se trouvent dans le même répertoire. Seulement, deux fichiers situer dans des répertoires différents, il ouvre celui dont le chemin est le plus long correctement tandis que pour celui dont le chemin est le plus court alors la c’est une catastrophe... (Perte de relation, perte de pièces…) pris séparément il n’y a pas de problème……C’est à n’y rien comprendre…..
16/12/2008, 10h39
pgz

Bonjour.

Peux-tu donner les codes correspondant aux deux comportements que tu décris?

PGZ

Le premier code est celui que tu m’a donné précédement :

Code:

1
2
3
4
5
6
7
8
9
10
11
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 Const ShExShowNormal = 1&
 
sub subOuvreFile
dim sFile as string, RetVal as long
 
sFile = "C:\Documents and Settings\Nom du PC\Bureau\Lancement des carrosseries\Dossier Gamme Basse\Fourgon GB\Face AV STD.asm"
RetVal = ShellExecute(0&, "Open", sFile, ByVal 0&, 0&, ShExShowNormal)
sFile = "C:\Documents and Settings\Nom du PC\Bureau\Lancement des carrosseries\Dossier Gamme Basse\Fourgon GB\Assemblage pavillon.asm"
RetVal = ShellExecute(0&, "Open", sFile, ByVal 0&, 0&, ShExShowNormal)
End Sub

Le second code est :

Code:

1
2
3
4
5
6
7
8
9
Sub Bouton15_QuandClic()
For x = 1 To 2 Step 1     'deux fichiers a ouvrir
stAppName = "C:\Program Files\Solid Edge V20\Program\Edge.exe"    'chemin de l'application
   If x = 1 Then chemin = """C:\Documents and Settings\Nom du PC\Bureau\Lancement des carrosseries\Dossier Gamme Basse\Fourgon GB\Face AV STD.asm"""      'chemin du premier fichier
   If x = 2 Then chemin = """C:\Documents and Settings\Nom du PC\Bureau\Lancement des carrosseries\Dossier Gamme Basse\Fourgon GB\Cadre AR\Porte à vantaux\Vue dessus pour mise en plan.asm"""             'chemin du second fichier
stAppName = stAppName & "  " & chemin
Call Shell(stAppName, vbMaximizedFocus)
Next x
End Sub

Bonjour,

pour ce genre de problématique j'utilise personnelement ShellExecuteEx qui à l'avantage de ramener l'ID du process initié.

Avantage: on peut tuer le process lancé et ainsi éviter d'avoir de multiples occurence qui restent ouvertes.

inconvénients : il faut savoir quand on peut tuer le process, quand il est terminé.

Ci-dessous un exemple de code pour afficher un fichier (Attachement_file) avec le viewer par défaut lié à ce type de fichier.
Je m'en sert pour afficher des PDF, sans me soucier de la version d'abode installée.
Ensuite, mais c'est spécifique à mon code, je tue le process précédent avcant d'afficher le nouveau pdf.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
 
Option Explicit
 
'Flags ShellExecuteEx
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400
 
'Constantes ERREUR ShellExecuteEx
Private Const SE_ERR_FNF As Byte = 2
Private Const SE_ERR_PNF As Byte = 3
Private Const SE_ERR_ACCESSDENIED As Byte = 5
Private Const SE_ERR_OOM As Byte = 8
Private Const SE_ERR_SHARE As Byte = 26
Private Const SE_ERR_ASSOCINCOMPLETE As Byte = 27
Private Const SE_ERR_DDETIMEOUT As Byte = 28
Private Const SE_ERR_DDEFAIL As Byte = 29
Private Const SE_ERR_DDEBUSY As Byte = 30
Private Const SE_ERR_NOASSOC As Byte = 31
Private Const SE_ERR_DLLNOTFOUND As Byte = 32
 
'Constantes AFFICHAGE ShellExecuteEx
Private Const SW_SHOWNORMAL = 1
Private Const SW_SHOW = 5
Private Const SW_SHOWDEFAULT = 10
 
Private Type SHELLEXECUTEINFO
    cbSize As Long
    fMask As Long
    hWnd As Long
    lpVerb As String
    lpFile As String
    lpParameters As String
    lpDirectory As String
    nShow As Long
    hInstApp As Long
    lpIDList As Long
    lpClass As String
    hkeyClass As Long
    dwHotKey As Long
    hIcon As Long
    hProcess As Long
End Type
 
'OpenProgram
Private Declare Function ShellExecuteEx Lib "shell32.dll" _
(SEI As SHELLEXECUTEINFO) As Long
 
 
'CloseProgram
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
 
Private Declare Function TerminateProcess Lib "kernel32" _
(ByVal hProcess As Long, ByVal uExitCode As Long) As Long
 
Private Declare Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
 
Public Const WM_CLOSE = &H10
Const GW_HWNDNEXT = 2
Dim mWnd                    As Long
Dim PhWnd                   As Long
Dim P_Attachement_file      As String
Private AppCible            As String

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
 
' ***********************************************************
' *
' * Lance le programme par défaut associé à un fichier (en fonction de son
' * extension ) et retourne le hWnd de la fênetre du programme lançé.
' *
' ***********************************************************
 
Public Function OpenProgram(ByRef Filename As String, ByRef OwnerhWnd As Long) As Long
    Dim SEI As SHELLEXECUTEINFO
 
    On Error GoTo ErrorHandler
 
    'Vérifie si le fichier à lancer est un exécutable (.exe)
    If GetExtension(Filename) = "exe" Then
        If vbNo = MsgBox("ATTENTION, êtes-vous sûr de vouloir lancer ce programme exécutable ?", vbExclamation + vbYesNo) _
        Then
            OpenProgram = 0
            Exit Function
        End If
    End If
 
    With SEI
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_FLAG_NO_UI
        .hWnd = OwnerhWnd
        .lpVerb = "open"
        .lpFile = Filename
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = SW_SHOW
        .hInstApp = OwnerhWnd
    End With
 
    OpenProgram = ShellExecuteEx(SEI)
 
    If SEI.hInstApp <= 32 Then
    'Erreurs
        OpenProgram = 0
 
        Select Case SEI.hInstApp
            Case SE_ERR_FNF
                OpenProgram = SEI.hProcess
            Case SE_ERR_PNF
                MsgBox "Le chemin du fichier à ouvrir est incorrect.", vbExclamation
            Case SE_ERR_ACCESSDENIED
                MsgBox "Accès au fichier refusé.", vbExclamation
            Case SE_ERR_OOM
                MsgBox "Mémoire insuffisante.", vbExclamation
            Case SE_ERR_DLLNOTFOUND
                MsgBox "Dynamic-link library non trouvé.", vbExclamation
            Case SE_ERR_SHARE
                MsgBox "Le fichier est déjà ouvert.", vbExclamation
            Case SE_ERR_ASSOCINCOMPLETE
                MsgBox "Information d'association du fichier incomplète.", vbExclamation
            Case SE_ERR_DDETIMEOUT
                MsgBox "Opération DDE dépassée.", vbExclamation
            Case SE_ERR_DDEFAIL
                MsgBox "Opération DDE echouée.", vbExclamation
            Case SE_ERR_DDEBUSY
                MsgBox "Opération DDE occupée.", vbExclamation
            Case SE_ERR_NOASSOC
                'Ouvrir avec...
                Call Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " + Filename, vbNormalFocus)
        End Select
    Else
        'Retourne le hWnd du programme lançé par ShellExecuteEx
        OpenProgram = SEI.hProcess
    End If
 
    Exit Function
ErrorHandler:
    OpenProgram = 0
End Function
 
' ***********************************************************
' *
' * Ferme un programme à partir du hWnd de sa fenêtre.
' *
' ***********************************************************
 
Public Function CloseProgram(hWnd As Long) As Boolean
    Dim lExitCode As Long
 
    If hWnd = 0 Then
        Exit Function
    End If
 
    On Error Resume Next
    CloseProgram = CBool(TerminateProcess(hWnd, lExitCode))
    'On Error Resume Next
    CloseHandle hWnd
    DoEvents
    Sleep (100)
 
End Function

le code suivant est dans un boucle de traitement des PDf d'un folder

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
                     If P_Attachement_file <> "" Then
                       If PhWnd <> 0 Then
                         'Close default Viewer if openedt
                         Call CloseProgram(PhWnd)
                         DoEvents
                       End If
                       Application.Wait (Now + TimeValue("0:00:05"))
'..... traitement 
                                           P_Attachement_file = ""
                    PhWnd = 0
 
                    Application.Wait (Now + TimeValue("0:00:01"))
                    '*************************************
                    'Show Attachement With Default Viewer
                    PhWnd = OpenProgram(Attachement_file, 0)
                    P_Phwnd = PhWnd

J'espère que cela pourra t'aider. :mouarf:

Voir 40 message(s) de cette discussion en une page