Double clic n'envoi pas sur la bonne ligne
bonjour tout le monde
mon fichier ci dessous est dote du code suivant :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'code pour ouverture doubleclic'
Dim chemin As String, fichier As String
Dim ligne As Long
If Not Intersect(Target, ListObjects("Tableau1").DataBodyRange) Is Nothing Then
chemin = Cells(Target.Row, 7) 'le chemin indique en colonne G"
ligne = Target.Offset(0, 1).Value
If Right(Target.Value, 4) = "" Then
fichier = Target.Value
Else: fichier = Target.Value & ""
End If
Cancel = False
If Len(Dir(chemin & fichier)) > 0 Then
Workbooks.Open Filename:=chemin & fichier, Format:=5 'le format pour conserver le texte'
ActiveWorkbook.ActiveSheet.Range("A" & ligne).NumberFormat = "@" 'format texte de la colonne A'
ActiveWorkbook.ActiveSheet.Range("A" & ligne).Select
Else: MsgBox "Le fichier ne semble pas exister dans le répertoire " & chemin
End If
End If
Cancel = True
End Subcelui ci permet quand on double clic sur une cellule de la colonne A d'ouvrir le fichier dont le nom est donc indiqué en A, le chemin en G et la ligne souhaité indiqué en colonne B; cela fonctionne tres bien sauf... quand la valeur de B est superieur à 1000 !
ça ouvre bien le fichier souhaité; le curseur se place lui aussi au bon endroit mais il n'est pas visible et l'on doit dérouler le document pour arriver visuellement au bon endroit.
quelqu'un pourrait il m'aider, svp ?
les fichiers ci dessous
Bonjour
tes offset étaient incohérents
comme ceci ça marche beaucoup mieux
double click n'importe ou dans une ligne
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'code pour ouverture doubleclic'
Dim chemin$, fichier$, lign&
If Not Intersect(Target, ListObjects("Tableau1").DataBodyRange) Is Nothing Then
'pour le fichier
'on utilise pas les offset mais le target.rows + colonne pour déterminer l'address de la bonne cellule
ligne = Cells(Target.Row, "B").Value 'N° de ligne
chemin = Cells(Target.Row, "G") 'chemin du dossier
fichier = chemin & Cells(Target.Row, "A") 'chemin complet du fichier
If Len(Dir(fichier)) > 0 Then
Workbooks.Open Filename:=fichier, Format:=5 'le format pour conserver le texte'
Cancel = True
DoEvents
ActiveWorkbook.ActiveSheet.Range("A" & ligne).NumberFormat = "@" 'format texte de la colonne A'
ActiveWorkbook.ActiveSheet.Range("A" & ligne).Select
'ActiveWindow.ScrollRow = ligne ' facultatif juste pour avoir la ligne en premiere position top (pour le visuel)
Else
MsgBox "Le fichier ne semble pas exister dans le répertoire " & chemin
Cancel = False
End If
End If
End Sub
j'ai figé la ligne 1 pour avoir les entêtes et les boutons toujours à portée
merci Patrick, c'est top.
le :
ActiveWindow.ScrollRow = ligne m'aurais suffit mais effectivement le le target.rows est bien plus simple à comprendre.
merci à toi.