XL 2021 Colorier un partie d'un txt

hermann à dit:

SVP, a supprimer le dossier: Feuile1
et a utiliser uniquement les dossier Collecte..... et Ibk-h-1932

Cliquez pour agrandir...

hermann à dit:

Le derniere scripte, pouvait l'envelopper dans un file ? merci

Cliquez pour agrandir...

Sub VerkettenUndEinfarben()
'
Dim Strasse As String, ID As String, Ergenis As String
Dim Beginn As Integer, Lange As Integer, i As Integer

    i = 4

    While Sheets("Ibk-h-1932").Range("B" & i).Value2 <> ""

        Strasse = Sheets("Ibk-h-1932").Range("J" & i).Value2
        ID = Sheets("Ibk-h-1932").Range("B" & i).Value2
        Ergebnis = Strasse & " (ID """ & ID & """)"

        Beginn = Len(Strasse) + 7
        Lange = Len(ID)

        With Sheets("Collecte-Ibk-1932")
            .Hyperlinks.Add .Range("F" & i), Address:="", SubAddress:="'Ibk-h-1932'!B" & i
            With .Range("F" & i)
                .Value2 = Ergebnis
                With .Font
                    .Underline = False
                    .Name = "Times New Roman"
                    .Size = 20
                    .Color = vbBlack
                End With
                With .Characters(Beginn, Lange).Font
                    .Bold = True
                    .Color = vbRed
                End With
            End With
        End With

        i = i + 1

    Wend

End Sub

TooFatBoy à dit:

C'est déjà ce que j'ai fait dans la réponse #23. 😉



C'est déjà le cas : le message #23 contient le fichier.
Mais je viens de me rendre compte que j'ai oublié de "calculer" le lien hypertexte dans le fichier 003. 🙁


Nouvelle proposition, avec le lien hypertexte cette fois-ci...

VB:

Sub VerkettenUndEinfarben()
'
Dim Strasse As String, ID As String, Ergenis As String
Dim Beginn As Integer, Lange As Integer, i As Integer

    i = 4

    While Sheets("Ibk-h-1932").Range("B" & i).Value2 <> ""

        Strasse = Sheets("Ibk-h-1932").Range("J" & i).Value2
        ID = Sheets("Ibk-h-1932").Range("B" & i).Value2
        Ergebnis = Strasse & " (ID """ & ID & """)"

        Beginn = Len(Strasse) + 7
        Lange = Len(ID)

        With Sheets("Collecte-Ibk-1932")
            .Hyperlinks.Add .Range("F" & i), Address:="", SubAddress:="'Ibk-h-1932'!B" & i
            With .Range("F" & i)
                .Value2 = Ergebnis
                With .Font
                    .Underline = False
                    .Name = "Times New Roman"
                    .Size = 20
                    .Color = vbBlack
                End With
                With .Characters(Beginn, Lange).Font
                    .Bold = True
                    .Color = vbRed
                End With
            End With
        End With

        i = i + 1

    Wend

End Sub

Cliquez pour agrandir...

TooFatBoy à dit:

C'est déjà ce que j'ai fait dans la réponse #23. 😉



C'est déjà le cas : le message #23 contient le fichier.
Mais je viens de me rendre compte que j'ai oublié de "calculer" le lien hypertexte dans le fichier 003. 🙁


Nouvelle proposition, avec le lien hypertexte cette fois-ci...

VB:

Sub VerkettenUndEinfarben()
'
Dim Strasse As String, ID As String, Ergenis As String
Dim Beginn As Integer, Lange As Integer, i As Integer

    i = 4

    While Sheets("Ibk-h-1932").Range("B" & i).Value2 <> ""

        Strasse = Sheets("Ibk-h-1932").Range("J" & i).Value2
        ID = Sheets("Ibk-h-1932").Range("B" & i).Value2
        Ergebnis = Strasse & " (ID """ & ID & """)"

        Beginn = Len(Strasse) + 7
        Lange = Len(ID)

        With Sheets("Collecte-Ibk-1932")
            .Hyperlinks.Add .Range("F" & i), Address:="", SubAddress:="'Ibk-h-1932'!B" & i
            With .Range("F" & i)
                .Value2 = Ergebnis
                With .Font
                    .Underline = False
                    .Name = "Times New Roman"
                    .Size = 20
                    .Color = vbBlack
                End With
                With .Characters(Beginn, Lange).Font
                    .Bold = True
                    .Color = vbRed
                End With
            End With
        End With

        i = i + 1

    Wend

End Sub

Cliquez pour agrandir...

hermann à dit:

Je peut ajoute toute le reste du fichier "H" ?

Cliquez pour agrandir...

TooFatBoy à dit:

C'est-à-dire ???

Cliquez pour agrandir...

TooFatBoy à dit:

Désolé, je ne comprends pas.

La macro commence en J4 de la feuille "Ibk-h-1932", crée le lien, et descend jusqu'à rencontrer une cellule vide en colonne J de la feuille "Ibk-h-1932".
Ca répond à ta question ?

Cliquez pour agrandir...

hermann à dit:

Je voudrais bien d'envoyer le fichier complet par message. Vous voyer être autre chose que moi ....

Cliquez pour agrandir...

TooFatBoy à dit:

Si le fichier contient des données personnelles, alors c'est contraire à RGPD, donc interdit sur ce forum. dans l'année 1932 toute est mord. Ce sont des info simple

Cliquez pour agrandir...