Lien hypertexte modifier ce code

[J-c]

Bonjour à toutes et à tous
Description: à partir d' un UserForm j'alimente en liens Hypertexte 3 colonnes
ceci sont envoyés vers la première ligne libre rencontrée

Pouvez vous m'aider à modifier ce code:

Option Explicit
 
Private Sub CommandButton1_Click() 'Nouvelle Fiche
    LigneCourante = Range("A65000").End(xlUp).Row + 1
    InitUSF1
    UserForm1.Show
End Sub
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'Consultation de fiche
Dim Derligne As Integer
Dim i As Byte
    Derligne = Range("A65000").End(xlUp).Row
    If Derligne > 1 And Not Intersect(Target, Range("A2:E" & Derligne)) Is Nothing Then
        InitUSF1
        LigneCourante = Target.Row
        For i = 1 To 3
            If Cells(LigneCourante, i + ColonneLien).Value <> "" Then
                ExisteDoc(i) = True
                Doc(i) = Cells(LigneCourante, i + ColonneLien).Hyperlinks.Item(1).Address
                With UserForm1.Controls("LHT" & i)
                    .Font.Bold = True
                    .ForeColor = &HFF0000
                    .Caption = "  " & Cells(LigneCourante, i + ColonneLien).Value
                End With
            End If
        Next i
        UserForm1.Show
        Cancel = True
    End If
End Sub
 
Private Sub InitUSF1()
Dim i As Byte
    For i = 1 To 3
        With UserForm1.Controls("LHT" & i)
            .Font.Bold = False
            .ForeColor = &H80000012
            .Caption = "  Document lié n°" & i
        End With
        ExisteDoc(i) = False
    Next i
End Sub

Pour que :
1° les liens créé soient envoyé vers la feuil2
2° éviter que l'osrque l'on rajoute un lien dans une colonne, que le chemin du dernier lien des autres colones se recopie .(Actuèlement si je rajoute des liens (colonne C) par exemple, les chemins des derniers liens des colonnes A et B sont recopié dans ces même colonnes)
Je joint un fichié surement plus explicite

Cordialement J-C

 

[job75]

Re : Lien hypertexte modifier ce code

Bonjour J-c,

Pour le point 2°, voir le fichier joint.

Si vous ne voulez pas que des liens soient créés dans les 3 colonnes, il ne faut pas faire de boucle dans la macro du bouton Valider de l'USF

Et puis il faut mémoriser l'endroit où a lieu le double-clic (variable lig) !!

Private Sub CommandButton1_Click() ' Bouton Valider
        With Sheets(1)
          If [COLOR="Red"]lig[/COLOR] Then [COLOR="red"]'voir macro CréerLien[/COLOR]
            [COLOR="red"]LigneCourante = .Cells(65536, lig + ColonneLien).End(xlUp).Row + 1[/COLOR]
            .Cells(LigneCourante, [COLOR="red"]lig[/COLOR] + ColonneLien).Value = Doc(lig)
            If ExisteDoc(lig) Then .Hyperlinks.Add Anchor:=.Cells(LigneCourante, [COLOR="red"]lig[/COLOR] + ColonneLien), _
              Address:=.Cells(LigneCourante, [COLOR="red"]lig[/COLOR] + ColonneLien), TextToDisplay:=NDF(Doc(lig))
          End If
        End With
    Unload Me
End Sub

Pour le point 1°, pas compris ce que vient faire Feuil2 là-dedans.

Un conseil : revoyez la logique de votre projet, en particulier sur l'utilisation des variables Public.

A+

 

[J-c]

Re : Lien hypertexte modifier ce code

Bonjour

Merci "Job75" pour cette réponse je teste tout de suite

Pour la "feuil2" je voudrais, en admettant que le bouton qui lance la macro soit sur une page de garde, que les liens créés soit stoké sur une autre page et non pas sur celle ou ce trouve le bouton comme c'est le cas actuèlement.
Cordialement J-C
Edit : Pour le point N°2 c'est parfait Merci Job75

 

[job75]

Re : Lien hypertexte modifier ce code

Re,

Hum, ben vous avez le choix du code :

With Feuil2

With Sheets(2)

With Sheets("Feuil2")

Ils n'ont pas tous le même intérêt, le 1er est sans doute préférable.

A+

 

[J-c]

Re : Lien hypertexte modifier ce code

Re

Ok merci, je vais chercher comment apliquer un de ces codes sur mon exemple


Cordialement J-C

Edit : Ok c'est bon Merci pour tous