XL 2019 Problème liens Hypertexte

Zapinet

XLDnaute Nouveau
Bonjour,

J'ai un petit problème sur mon code VBA.
Je Recherche un fichier PDF sur mon PC via le Bouton "Fichier joint" une fois valider il viens dans ma listbox en dessous . Puis quand je double clic sur la listbox le liens ce transfère dans la TextBox en dessous. Quand je Clic sur Valider je veux que le lien Hypertexte aille dans la colone B avec pour TextTodisplay = Txtinter. Value (soit la text box N°d'inter).
Tout fonctionne sauf... que mon numéro d'inter va bien en "B" sans hypertext et le lien HyperText que je désire va sur une autre cellule avec le nom de numéro d'inter et en liens Hypertexte.

Le Code :

VB:
Private Sub CBXFichier_Click()
Dim fichier_choisi As String

fichier_choisi = Application.GetOpenFilename("Fichiers Adobe PDF (*.pdf), *.pdf*", , "Sélectionner une intervention")

If (LCase(fichier_choisi) <> "faux" And fichier_choisi <> "0") Then
    liste_fichiers.AddItem (fichier_choisi)
   
    End If
   

End Sub

Private Sub CMDFERMER_Click()

Unload Me

End Sub

Private Sub liste_fichiers_DblClick(ByVal cancel As MSForms.ReturnBoolean)

Txtfichier.Text = liste_fichiers.List(liste_fichiers.ListIndex, 0)

End Sub


Private Sub Cmdvalider_Click()

Sheets("ARCHIVES 2").Select



Dim L As Integer
Dim i As Integer

 If MsgBox("Confirmez-vous l'insertion de cette nouvelle intervention ?", vbYesNo, "Demande de confirmation d'ajout") = vbYes Then
     'L = Sheets("ARCHIVES 2").Range("a65536").End(xlUp).Row + 1

        For i = 6 To 6500
        If Range("B" & i).Value = "" Then
        L = i
        i = 6600
        End If
        Next i
       
 ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Me.Txtfichier.Value, TextToDisplay:=Txtinter.Value

     Range("B" & L).Value = Txtfichier
     Range("B" & L).Value = Txtinter
     Range("C" & L).Value = Txtcstc
     Range("D" & L).Value = Txtadresse
     Range("E" & L).Value = Txtdemande
     Range("F" & L).Value = CBXcate
     Range("G" & L).Value = CBXope
     Range("H" & L).Value = CBXstatique
     Range("I" & L).Value = CBXosg
     Range("J" & L).Value = Txtdate

 End If
'Sheets("STATIQUE").Select

End Sub



Private Sub UserForm_Initialize()
Txtdate.Value = Format(Date, "dd / mm / yyyy")
End Sub
 

Pièces jointes

  • Formulaire.PNG
    Formulaire.PNG
    19.4 KB · Affichages: 24
  • Tableau.PNG
    Tableau.PNG
    24.8 KB · Affichages: 23
Dernière modification par un modérateur:
Solution
Nous ce que l'on attends c'est 3 ou 4 lignes remplis correctement à la main
100 % d'accord avec cela. Cela aurait été beaucoup mieux !

Je fais tout de même une proposition en pièce jointe, avec modification de la macro Cmdvalider_Click.

VB:
Private Sub Cmdvalider_Click()
'
Dim L As Integer
'Dim i As Integer

    With Sheets("ARCHIVES 2")

        .Select     ' Inutile, sauf si on veut absolument que l'utilisateur voit la feuille avant de répondre à la question posée

        If MsgBox("Confirmez-vous l'insertion de cette nouvelle intervention ?", vbYesNo, "Demande de confirmation d'ajout") = vbYes Then

'            L = Sheets("ARCHIVES 2").Range("a65536").End(xlUp).Row + 1
'            For i = 6 To 6500
'...
Bonjour Zapinet, TooFatBoy, Phil69970, le forum

@Zapinet , il est toujours mieux de fournir un fichier de test light et anonymisé, comme le dit Phil69970, pas facile de tester un code sur une image de fichier et c'est à vous de faciliter le travail des contributeurs puisque c'est vous qui demandez de l'aide. Et mettez donc vos codes dans des balises, petit bouton </>, c'est beaucoup plus agréable pour ceux qui essaient de vous aider.
je le modifie sur votre premier post.

Cordialement, @+
 

Phil69970

XLDnaute Barbatruc
Bonjour à tous

Quelques remarques :
1) Dans le fichier joint cela aurait été mieux si il y avait quelques lignes remplis pour voir ce que tu attends

2) Que veux tu faire ici ?

For i = 6 To 6500
If Range("B" & i).Value = "" Then
L = i
i = 6600
End If
Next i

Si c'est pour avoir la dernière ligne rempli de la colonne B il y a beaucoup plus simple que faire une boucle 6500 fois !

3) Que veux tu faire ici ? (Voir la remarque de @TooFatBoy )

Range("B" & L).Value = Txtfichier
Range("B" & L).Value = Txtinter

Pour moi dans la cellule (B & L) tu mets la valeur de la txtfichier et juste après tu la remplaces par la valeur de Txtinter à quoi cela sert il et quel est l’intérêt ??

Bonne lecture

@Phil69970
 

Zapinet

XLDnaute Nouveau
Bonjour à tous

Quelques remarques :
1) Dans le fichier joint cela aurait été mieux si il y avait quelques lignes remplis pour voir ce que tu attends

2) Que veux tu faire ici ?



Si c'est pour avoir la dernière ligne rempli de la colonne B il y a beaucoup plus simple que faire une boucle 6500 fois !

3) Que veux tu faire ici ? (Voir la remarque de @TooFatBoy )



Pour moi dans la cellule (B & L) tu mets la valeur de la txtfichier et juste après tu la remplaces par la valeur de Txtinter à quoi cela sert il et quel est l’intérêt ??

Bonne lecture

@Phil69970
1) désoler j ai fais rapidement mais ce que j attend c est simplement que le liens hypertexte prenne la valeur de Txtinter et vienne dans la Colonne B .
2) il y a peux être plus simple effectivement mais j ai trouvé ça pour que ça remplisse directement la première ligne vide et pour
le 3) j ai juste fais des essais et quand j en supprime un bien le résultat et encore plus mauvais ça remplis par le liens hypertextes et non par la valeur .
 

Phil69970

XLDnaute Barbatruc
Re

1) désoler j ai fais rapidement mais ce que j attend c est simplement que le liens hypertexte prenne la valeur de Txtinter et vienne dans la Colonne B .

Nous ce que l'on attends c'est 3 ou 4 lignes remplis correctement à la main

Voici un exemple pour avoir la dernière ligne de la colonne B rempli

Dim Derlig&
Derlig = Range("B" & Rows.Count).End(xlUp).Row

Et pour avoir la 1ere ligne vide de la colonne B directement :

Dim Derlig&
Derlig = Range("B" & Rows.Count).End(xlUp).Row + 1

Bonne lecture

@Phil69970
 

TooFatBoy

XLDnaute Barbatruc
Nous ce que l'on attends c'est 3 ou 4 lignes remplis correctement à la main
100 % d'accord avec cela. Cela aurait été beaucoup mieux !

Je fais tout de même une proposition en pièce jointe, avec modification de la macro Cmdvalider_Click.

VB:
Private Sub Cmdvalider_Click()
'
Dim L As Integer
'Dim i As Integer

    With Sheets("ARCHIVES 2")

        .Select     ' Inutile, sauf si on veut absolument que l'utilisateur voit la feuille avant de répondre à la question posée

        If MsgBox("Confirmez-vous l'insertion de cette nouvelle intervention ?", vbYesNo, "Demande de confirmation d'ajout") = vbYes Then

'            L = Sheets("ARCHIVES 2").Range("a65536").End(xlUp).Row + 1
'            For i = 6 To 6500
'                If Range("B" & i).Value = "" Then
'                    L = i
'                    i = 6600
'                End If
'            Next i
            If .Range("B7").Value = "" Then
                L = 7
            Else
                L = .Range("B6").End(xlDown).Row + 1
            End If
 
'            ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=Txtfichier.Value, TextToDisplay:=Txtinter.Value

'            .Range("B" & L).Value = Txtfichier
'            .Range("B" & L).Value = Txtinter
            .Hyperlinks.Add Anchor:=.Range("B" & L), Address:=Txtfichier.Value, TextToDisplay:=Txtinter.Value
            .Range("C" & L).Value = Txtcstc
            .Range("D" & L).Value = Txtadresse
            .Range("E" & L).Value = Txtdemande
            .Range("F" & L).Value = CBXcate
            .Range("G" & L).Value = CBXope
            .Range("H" & L).Value = CBXstatique
            .Range("I" & L).Value = CBXosg
            .Range("J" & L).Value = Txtdate

        End If

    End With

'    Sheets("STATIQUE").Select

End Sub



Je pense que ton problème de lien qui ne se mettait pas au bon endroit venait du Anchor de ton lien : avec Anchor:=Selection le lien va se mettre dans la cellule sélectionnée, qui n'est pas forcément dans la colonne B ni sur la ligne désirée... ;)
 

Pièces jointes

  • Archives_(TooFatBoy-v1).xlsm
    143.2 KB · Affichages: 5
Dernière édition:

Discussions similaires

Réponses
4
Affichages
165
Réponses
6
Affichages
202