Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 Problème liens Hypertexte

Z

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
    19.4 KB · Affichages: 26
  • Tableau.PNG
    24.8 KB · Affichages: 25
Dernière modification par un modérateur:
Solution
Phil69970 à dit:
Nous ce que l'on attends c'est 3 ou 4 lignes remplis correctement à la main
Cliquez pour agrandir...
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
'...
Trier par date Trier par votes

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
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, @+
 
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Je ne sais pas ce que contient Txtinter, mais je suis surpris que ça vienne écraser Txtfichier.

C'est tout ce que je voulais, et peux, dire avec des images et un extrait de code.
 
Dernière édition:
Vote positif 0 Vote négatif

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
Cliquez pour agrandir...

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
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif
Z

Zapinet

XLDnaute Nouveau
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 .
 
Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc
Re

Zapinet à dit:
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 .
Cliquez pour agrandir...

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
Cliquez pour agrandir...

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

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

Bonne lecture

@Phil69970
 
Vote positif 0 Vote négatif

TooFatBoy

XLDnaute Barbatruc
Phil69970 à dit:
Nous ce que l'on attends c'est 3 ou 4 lignes remplis correctement à la main
Cliquez pour agrandir...
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: 6
Dernière édition:
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

F
  • Question
Microsoft 365 aide VBA excel
Réponses
4
Affichages
302
Oneida
S
  • Question
XL 2016 Problème dans la création d'une liste
Réponses
2
Affichages
326
Stéphane_1
S
D
  • Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
888
AtTheOne
A
  • Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
136
patricktoulon
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
404
Chaton77
F
  • Question
Microsoft 365 Problème avec VBA ( Résolu)
Réponses
2
Affichages
301
firecarl
F
F
  • Résolu(e)
Microsoft 365 Recherche à partir d'une TextBox
Réponses
4
Affichages
449
Francky79
F
T
  • Résolu(e)
XL 2016 macro et feuille protégé
2
Réponses
18
Affichages
593
laurent950
  • Résolu(e)
Microsoft 365 Amélioration codage
Réponses
4
Affichages
417
pompaero
M
  • Question
Microsoft 365 Erreur sur mon Code VBA
Réponses
2
Affichages
349
Gégé-45550
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…