Problème code vba en double clic sur cellule

[bruno66]

bonjour...
suite à une modification d'un fichier, je suis confronté a une erreur dans mon code, si vous pouviez me donner un petit coup de main merci d'avance


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Not Intersect(Target, [Q13:Q3000]) Is Nothing Then
Sheets("Stock").Select
ActiveSheet.Range("A3:X3000").AutoFilter Field:=6, Criteria1:=Target
End If
On Error GoTo 0

Else Intersect(Target, [L13:L3000]) Nothing Then
On Error Resume Next
'Workbooks.Open ActiveWorkbook.Path & "/Profil DXF/" & Target.Value & ".dxf"
Shell ("D:\Program Files\IGC\Free DWG Viewer\BravaFreeDWG.exe " & ActiveWorkbook.Path & "\Profil DXF\" & Target.Value & ".dxf"), vbMaximizedFocus
If Err.Number <> 0 Then
Call MsgBox("Le fichier " & Chr(34) & " " & Target.Value & ".dxf " & Chr(34) & " n'éxiste pas dans le répertoire Profil DXF.", vbCritical, "Manque fichier profil")
Target.Select
End If



MERCI D'AVANCE problème de syntaxe

 

[CHALET53]

Re : Problème code vba en double clic sur cellule

bonjour,

Else Intersect(Target, [L13:L3000]) Nothing

Je ne suis pas sûr que sous cette forme ça fonctionne : je ne connais que : if not intersect(Target, [L13:L3000]) is Nothing

a+

 

[bruno66]

Re : Problème code vba en double clic sur cellule

bonjour jean- Marcel..
cette macro est dans un fichier.. de gestion de stock que j'ai réalisé pour de la gestion de profilé d'aluminium
la première fonction de ce code me permet d'ouvrir une feuille spécifique du fichier , et de sélectionner juste le ligne que j'ai besoin


la deuxième fonction de la macro me permet aussi en double- cliquant sur une autre cellule dans une autre colonne , de m'ouvrir dans un fichier DWG , par l'intermediaire d'une visionneuse de DWG , le profil dont je veut voir le dessin..

j'avais la formule pour ouvrir un pdf , un excel , et le dwg , sur un autre fichier, mais j'ai un problème juste de comme tu dit else... ou autre
car dans l'autre formule j'utilisais une cellule quelconque
merci de ton aide

 

[bruno66]

Re : Problème code vba en double clic sur cellule

re bonjour

je re-poste mon code... qui ne fonctionne pas en entier

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
If Not Intersect(Target, [Q13:Q3000]) Is Nothing Then
'quand double clic dans colonne entre Q13 a Q3000
Sheets("Stock").Select
'ouvre la feuille stock du fichier
ActiveSheet.Range("A3:X3000").AutoFilter Field:=6, Criteria1:=Target
'autofiltre et affiche la ligne de la la colonne 6 selectionné
End If
On Error GoTo 0
ElseIf Intersect(Target, [L13:L3000]) Is Nothing Then
'quand double clic dans colonne entre L13 et L3000
On Error Resume Next
'Workbooks.Open ActiveWorkbook.Path & "/Profil DXF/" & Target.Value & ".dxf"
'active le programme , ouvre le fichier dans le dossier en relation
Shell ("C:\Program Files\IGC\Free DWG Viewer\BravaFreeDWG.exe " & ActiveWorkbook.Path & "\Profil DXF\" & Target.Value & ".dxf"), vbMaximizedFocus
If Err.Number <> 0 Then
Call MsgBox("Le fichier " & Chr(34) & " " & Target.Value & ".dxf " & Chr(34) & " n'éxiste pas dans le répertoire Profil DXF.", vbCritical, "Manque fichier profil")
Target.Select
End If
On Error GoTo 0
End If
End Sub


vraiment désolé de revenir encore une fois merci d'avance

 

[bruno66]

Re : Problème code vba en double clic sur cellule

bonjour Jean -Marcel

j'ai mis ton code dans mon fichier.. mais j'avais un autre erreur concernant aussi le fichier "DWG "a la place de" profil DXF "a extraire et de format aussi en" DXF" a la place de de" DWG "

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([Q13:Q3000], Target) Is Nothing Then
Sheets("Stock").Select
ActiveSheet.Range("A3:X3000").AutoFilter Field:=6, Criteria1:=Target
Exit Sub
End If
If Not Intersect(Target, [L13:L3000]) Is Nothing Then
'quand double clic dans colonne entre L13 et L3000
On Error Resume Next
'Workbooks.Open ActiveWorkbook.Path & "/DWG/" & Target.Value & ".dxf"
Shell ("C:\Program Files\IGC\Free DWG Viewer\BravaFreeDWG.exe " & ActiveWorkbook.Path & "\DWG\" & Target.Value & ".dwg"), vbMaximizedFocus
If Err.Number <> 0 Then
Call MsgBox("Le fichier " & Chr(34) & " " & Target.Value & ".dwg " & Chr(34) & " n'éxiste pas dans le répertoire Profil DXF.", vbCritical, "Manque fichier profil")
End If
End If
End Sub

cela fonctionne impeccablement sur mon fichier
un grand merci a toi
amicalement au plaisir

 

[bruno66]

Re : Problème code vba en double clic sur cellule

bonjour .. suivant mon code qui fonctionne ci dessous , je cherche a pouvoir refermer le fichier


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([Q13:Q3000], Target) Is Nothing Then
Sheets("Stock").Select
ActiveSheet.Range("A3:X3000").AutoFilter Field:=6, Criteria1:=Target
Exit Sub
End If
If Not Intersect(Target, [L13:L3000]) Is Nothing Then
'quand double clic dans colonne entre L13 et L3000
On Error Resume Next
'a ce niveau, je cherche un code pour fermer le fichier DWG si ouvert quand je double clic dans autre cellule( c'est une visionneuse de fichier DWG sans enregistrement ouvrir /fermer

'Workbooks.Open ActiveWorkbook.Path & "/DWG/" & Target.Value & ".dxf"
Shell ("C:\Program Files\IGC\Free DWG Viewer\BravaFreeDWG.exe " & ActiveWorkbook.Path & "\DWG\" & Target.Value & ".dwg"), vbMaximizedFocus
If Err.Number <> 0 Then
Call MsgBox("Le fichier " & Chr(34) & " " & Target.Value & ".dwg " & Chr(34) & " n'éxiste pas dans le répertoire Profil DXF.", vbCritical, "Manque fichier profil")
End If
End If
End Sub

si quelqu'un a une idée pour me faire avancer merci