Microsoft 365 Lien hypertexte

Othmane204 · 2 Décembre 2022

Bonjour à tous,

Je suis entrain de créer une facture avec VBA, et je bloque à cause d'une fonction que j'aimerais appliquer, j'ai beau cherché mais je ne trouves pas ce que je cherche.

Je veux créer un lien hypertexte a travers la derniere feuille ajoutée dans le classeur et mettre le lien dans une cellule predefinie dans une autre feuille ("HISTORIQUE FACTURES") par exemple cellule K4. Et je veux que ca s'ajoute sur une nouvelle ligne a chaque fois que je crée une feuille

Voici le code où je suis arrivé.

Sheets("HISTORIQUE FACTURES").Select
ligne = Range("A2").End(xlDown).Row + 1
ActiveSheet.Hyperlinks.Add Anchor:=Cells(ligne, 1), Address:="", SubAddress:= _
Sheets(Sheets.Count).Name & "!A1", TextToDisplay:=Sheets("FACTURE").Range("K18") & " " & Sheets("FACTURE").Range("F23").Value

Merci d'avance!

Othmane204 · 2 Décembre 2022

Bonsoir à tous je tiens à vous remercier pour vos efforts et votre aide, je vous informe que finallement je suis arrivé au résultat voulu grace au code suivant :

VB:

Dim Derlig&
With Sheets("HISTORIQUE FACTURES")
    Derlig = .Range("L" & Rows.Count).End(xlUp).Row + 1
    .Hyperlinks.Add Anchor:=.Cells(Derlig, 12), Address:="", SubAddress:= _
    "'" & Sheets(Sheets.Count).Name & "'!A1", TextToDisplay:=Sheets("FACTURE").Range("K18") & " " & Sheets("FACTURE").Range("F23").Value & "!A1"
End With

C'est bien ce que @Phil69970 m'avait proposé, c'est juste qu'il devait mettre les apostrophes devant et derrière le nom.

Merci encore!

Othmane204 · 2 Décembre 2022

job75 à dit:
Dans la feuille HISTORIQUE FACTURES la colonne Désignation ne va pas.

En effet dans chaque facture il y a plusieurs lignes pour Désignation.

Il faudrait donc supprimer cette colonne non ?

Non non j'en aurais besoin par la suite

Phil69970 · 2 Décembre 2022

Re

Othmane204 à dit:
Sachez que j'ai corrigé la colonne en L et ca marche toujours pas

Et pourtant cela marche !!!

@Phil69970

Othmane204 · 2 Décembre 2022

Phil69970 à dit:
Re

Et pourtant cela marche !!!

Regarde la pièce jointe 1157040

@Phil69970

J'ai fait exactement comme vous, mais je recois une erreur dans la partie surligner.

job75 · 2 Décembre 2022

Voyez le fichier joint et le code de la feuille HISTORIQUE FACTURES :

VB:

Private Sub Worksheet_Activate()
Dim lig&, w As Worksheet, a(1 To 11), i%
Application.ScreenUpdating = False
With [Tableau1] 'tableau structuré
    .Rows(1).ClearContents 'RAZ
    If .Rows.Count > 1 Then .Rows(2).Resize(.Rows.Count - 1).Delete xlUp 'RAZ
    lig = 1
    For Each w In Worksheets
        Erase a 'RAZ
        a(1) = w.Range("K18") & " " & w.Range("F23")
        If LCase(a(1)) = LCase(w.Name) Then
            a(2) = w.Range("F26")
            For i = 3 To 7
                a(i) = w.Range("K" & 15 + i)
            Next i
            a(8) = w.Range("E29") 'bizarre non ???
            On Error Resume Next 'au cas où...
            a(9) = w.Columns("K").Find("sous-total", , xlValues)(1, 2)
            a(10) = w.Columns("J").Find("TVA")(1, 3)
            a(11) = w.Columns("K").Find("TTC")(1, 2)
            On Error GoTo 0
            .Rows(lig) = a 'restitution
            Hyperlinks.Add .Cells(lig, 1), "", "'" & w.Name & "'!A1" 'création du lien
            lig = lig + 1
        End If
    Next w
End With
End Sub

Le tableau se met à jour quand on active la feuille.

Othmane204 · 2 Décembre 2022

job75 à dit:

Voyez le fichier joint et le code de la feuille HISTORIQUE FACTURES :

VB:

Private Sub Worksheet_Activate()
Dim lig&, w As Worksheet, a(1 To 11), i%
Application.ScreenUpdating = False
With [Tableau1] 'tableau structuré
    .Rows(1).ClearContents 'RAZ
    If .Rows.Count > 1 Then .Rows(2).Resize(.Rows.Count - 1).Delete xlUp 'RAZ
    lig = 1
    For Each w In Worksheets
        Erase a 'RAZ
        a(1) = w.Range("K18") & " " & w.Range("F23")
        If LCase(a(1)) = LCase(w.Name) Then
            a(2) = w.Range("F26")
            For i = 3 To 7
                a(i) = w.Range("K" & 15 + i)
            Next i
            a(8) = w.Range("E29") 'bizarre non ???
            On Error Resume Next 'au cas où...
            a(9) = w.Columns("K").Find("sous-total", , xlValues)(1, 2)
            a(10) = w.Columns("J").Find("TVA")(1, 3)
            a(11) = w.Columns("K").Find("TTC")(1, 2)
            On Error GoTo 0
            .Rows(lig) = a 'restitution
            Hyperlinks.Add .Cells(lig, 1), "", "'" & w.Name & "'!A1" 'création du lien
            lig = lig + 1
        End If
    Next w
End With
End Sub

Le tableau se met à jour quand on active la feuille.

Re,
Je ne sais pas pourquoi mais la macro de votre fichier se desactive

Othmane204 · 2 Décembre 2022

Bonsoir à tous je tiens à vous remercier pour vos efforts et votre aide, je vous informe que finallement je suis arrivé au résultat voulu grace au code suivant :

VB:

Dim Derlig&
With Sheets("HISTORIQUE FACTURES")
    Derlig = .Range("L" & Rows.Count).End(xlUp).Row + 1
    .Hyperlinks.Add Anchor:=.Cells(Derlig, 12), Address:="", SubAddress:= _
    "'" & Sheets(Sheets.Count).Name & "'!A1", TextToDisplay:=Sheets("FACTURE").Range("K18") & " " & Sheets("FACTURE").Range("F23").Value & "!A1"
End With

C'est bien ce que @Phil69970 m'avait proposé, c'est juste qu'il devait mettre les apostrophes devant et derrière le nom.

Merci encore!

job75 · 3 Décembre 2022

Othmane204 à dit:
Je ne sais pas pourquoi mais la macro de votre fichier se desactive

Une macro ne se désactive pas quand les macros ont été activées.

Ma macro est une macro évènementielle à placer dans le code de la feuille HISTORIQUE FACTURES.

Elle s'exécute automatiquement quand on active la feuille.

Microsoft 365 Lien hypertexte

Othmane204

XLDnaute Nouveau

Othmane204

Othmane204

XLDnaute Nouveau

Phil69970

XLDnaute Barbatruc

Othmane204

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

Othmane204

XLDnaute Nouveau

Othmane204

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Discussions similaires

Microsoft 365 Lien hypertexte

XLDnaute Nouveau

​

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

​

XLDnaute Barbatruc

Discussions similaires