Microsoft 365 Lien hypertexte

[Othmane204]

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]

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]

Re

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

Et pourtant cela marche !!!

@Phil69970

 

[Othmane204]

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]

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

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]

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

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]

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 :

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]

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.