XL 2016 Cette macro me change la taille et l'alignement de ma cellule ?

[christ77000]

Bonjour à tous, sur ce site j'ai récupéré une macro qui correspond exactement a ce que je voulais faire. Le seul petit problème est quelle me change la taille et le centrage de mes cellules du coup le texte dépasse de la cellule. A l'origine mes cellules en une police de taille 8 et centrée. je termine en taille 10 et aligner en bas. Et je ne comprends pas pourquoi. Merci pour votre aide.

J'ais en AE1:AE67 une liste de mes onglets.
en C12:K12 une liste déroulante de ces onglets, et après le choix la création du lien.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range, test As Boolean
Set r = [C12:K12] 'plage à adapter
Application.ScreenUpdating = False
r.Hyperlinks.Delete 'RAZ
On Error Resume Next
For Each r In r
    If r <> "" Then
        test = False
        test = r.Validation.Type = xlValidateList
        If test Then r.Hyperlinks.Add r, "", "'" & r & "'!A1"
    End If
Next
End Sub

 

[Compte Supprimé 979]

Bonjour christ77000
Normal, tu ajoutes un lien hypertexte qui a une mise en forme particulière.
Si tu veux garder la même police et le même alignement, il faut le spécifier dans ton code

 

[christ77000]

Merci pour ta réponse, c'est ce que j'ai fait depuis le poste de mon message mais Excel plante !! mais je pense que je me suis trompé sur la syntaxe

 

[christ77000]

j'ai ajouter cela en fin de code

Range("C12:K12").Select
    Range("K12").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 7
    End With

 

[Compte Supprimé 979]

Re,

Essaye comme ceci

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range, test As Boolean
Set r = [C12:K12] 'plage à adapter
Application.ScreenUpdating = False
r.Hyperlinks.Delete 'RAZ
On Error Resume Next
For Each r In r
    If r <> "" Then
        test = False
        test = r.Validation.Type = xlValidateList
        If test Then
            r.Hyperlinks.Add r, "", "'" & r & "'!A1"
            r.HorizontalAlignment = xlCenter
            With r.Font
                .Name = "Arial"
                .Size = 7
            End With
        End If
    End If
Next
End Sub

@+

 

[christ77000]

Merci pour ton aide, une petite question en supp pourquoi la macro me protège les cellules alors que a la base il n'y a pas de protection dans cette plage de cellule. Ce qui fait que si je change mon choix d'onglets ou le supprime et bien la macro me dit cellule protégée !!

 

[christ77000]

Je ne vois pas ce qui cloche dans ce code. Il fonctionne une fois et après il bloque.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range, test As Boolean
Set r = [C12:K12] 'plage à adapter
Application.ScreenUpdating = False
Call Retirer_la_protection '---retire la protection de la feuille---
r.Hyperlinks.Delete 'RAZ
On Error Resume Next
For Each r In r
    If r <> "" Then
        test = False
        test = r.Validation.Type = xlValidateList
        If test Then
            r.Hyperlinks.Add r, "", "'" & r & "'!A1"
            r.HorizontalAlignment = xlCenter
            r.VerticalAlignment = xlCenter
            r.Borders.Weight = xlThin
            With r.Font
                .Name = "Arial"
                .Size = 7
        End With
        End If
    End If
Next
Call Protéger_la_feuille '---proteger la feuille---

End Sub

 

[Compte Supprimé 979]

Re,

Met en commentaire le

On Error Resume Next

Comme ça tu auras un débogage et tu seras quelle ligne pose problème

 

[christ77000]

ca plante sur "r.Hyperlinks.Delete 'RAZ" mais quand je désactive la ligne "Call Protéger_la_feuille '---proteger la feuille---" ca fonctionne sauf que je perd la protection total de ma feuille

 

[Compte Supprimé 979]

Re,

C'est normal que ça bogue s'il n'y a pas de Hyperlink
Essaye comme ça

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r As Range, test As Boolean
Set r = [C12:K12] 'plage à adapter
Application.ScreenUpdating = False
Call Retirer_la_protection '---retire la protection de la feuille---
On Error Resume Next
r.Hyperlinks.Delete 'RAZ
On Error Goto 0
For Each r In r
    If r <> "" Then
        test = False
        test = r.Validation.Type = xlValidateList
        If test Then
            r.Hyperlinks.Add r, "", "'" & r & "'!A1"
            r.HorizontalAlignment = xlCenter
            r.VerticalAlignment = xlCenter
            r.Borders.Weight = xlThin
            With r.Font
                .Name = "Arial"
                .Size = 7
        End With
        End If
    End If
Next
Call Protéger_la_feuille '---proteger la feuille---
End Sub

@+

 

[christ77000]

si il y a bien un lien de créé mai impossible de choisir un autre et impossible de le supprimer, même avec ton code. même sans rien mettre dans cellule elle se protège. Je retire la protection de la feuille et retire manuellement dans format cellule la protection et des que je relance le code sans rien d'autre que cliquer dans la cellule elle se re protèges

 

[christ77000]

quand je retire la macro et renseigne le lien manuellement la cellule reste bien dans son état, sans protection ?