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
| Private Sub but_det2d_Click() ' si l'utilisateur clique sur le bouton det2d
Dim a As String, b As String, c As String, d As String, tdm As String, chemfich As String, chemprog As String, retval As Variant
If cb_ch.Value = "" Or cb_nv.Value = "" Or cb_loc.Value = "" Or cb_opt.Value = "" Or (ob_h.Value = False And ob_v.Value = False And ob_ind.Value = False) Then 'vérifie si l'utilisateur a renseigné tous les champs
MsgBox "Veuillez remplir tous les champs ou selectionner un détail dans la liste.", , "Elément manquant!"
Else:
ScreenUpdating = False 'désactivation du rafraichissement de l'écran
Dim ChemindeTravail As String
a = cb_ch.Value 'a prend la valeur de la Combobox cb_ch (liste des chantiers)
b = cb_nv.Value 'b prend la valeur de la Combobox cb_nv (liste des niveaux)
c = cb_loc.Value 'c prend la valeur de la Combobox cb_loc(liste des jonctions)
d = cb_opt.Value 'd prend la valeur de la Combobox cb_opt(liste des particularités)
If Détails.ob_h = True Then tdm = Détails.ob_h.Caption 'tdm prend la valeur de la case option selectionnée
If Détails.ob_v.Value = True Then tdm = Détails.ob_v.Caption
If Détails.ob_ind.Value = True Then tdm = Détails.ob_ind.Caption
ChemindeTravail = ActiveWorkbook.Path & "\Détails\" & a & "\" & b & "\" & tdm & "\" & c & "\" 'la variable chemin de travail prend la valeur du chemin du fichier actif\Détails et toutes lesvaleurs renseignées
'On Error GoTo introuvable 'sur une erreur aller à introuvable
'SW_SHOWNORMAL = 1
chemfich = ChemindeTravail & b & " " & c & " " & d & ".2d"
chemprog = "C:\CADWORK.DIR\EXE_21\2d\2DVIEW.exe"
retval = Shell(chemprog & " " & chemfich, vbNormalFocus)
'devrait, à priori fonctionner, l'exécutable se lance sans problème, mais il m'annonce "Not a valid file name : (toutes les variables de chemfich)" Il doit avoir un problème pour ouvrir le fichier à cause du chemin, le logiciel considère le chemin ET le nom du fichier comme le nom du fichier, l'adresse est pourtant bonne, les fichiers sont enregistrés automatiquement et renommés automatiquement, l'accès au fichier .pdf portant exactement le même nom fonctionne avec 'ThisWorkbook.FollowHyperlink Address
'sOuvrir = "rundll32.exe shell32.dll,OpenAs_RunDLL " & chemfich
'retval = Shell(sOuvrir, vbMaximizedFocus) 'fonctionne parfaitement bien mais ne correspond pas à mon attente
'retval = shellexecute(0, "open", chemfich, chemprog, 0, SW_SHOWNORMAL) 'test d'un type d'ouverture présentant l'erreur "Point d'entrée shellExecute a d'une DDL introuvable dans shell32.dll"
'ThisWorkbook.FollowHyperlink Address:=ChemindeTravail & b & " " & c & " " & d & ".2d" 'ouverture du détail 2D avec le programme par défaut (ne correspond pas à mon attente)
ScreenUpdating = True 'activation du rafraichissement de l'écran
End If
Exit Sub
introuvable: MsgBox "Le détail 2D que vous demandez n'existe pas pour ces critères veuillez le rajouter ou en sélectionner un autre.", , "Détail non trouvé."
End Sub |
Partager