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

christ77000

XLDnaute Occasionnel
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.

VB:
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
 
Solution
C
Re,

Essaye comme ceci ;)
VB:
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
@+
C

Compte Supprimé 979

Guest
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 ;)
 
C

Compte Supprimé 979

Guest
Re,

Essaye comme ceci ;)
VB:
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

XLDnaute Occasionnel
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 !!
 
Dernière édition:

christ77000

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

VB:
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
 
C

Compte Supprimé 979

Guest
Re,

C'est normal que ça bogue s'il n'y a pas de Hyperlink ;)
Essaye comme ça
VB:
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

XLDnaute Occasionnel
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
 

Discussions similaires

Réponses
7
Affichages
292

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof