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 Sub

celui 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

8doc-forum.txt (22.01 Ko)

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
demo

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.

Rechercher des sujets similaires à "double clic envoi pas bonne ligne"