format dynamic range

[jan martens]

Bonjour à tous,

J'ai une dynamic range nommé Anna1 DECALER(b1;0;0;a1;a2) avec des valeurs en a1 et a2 variant entre 3 et 8.


Je voudrais en ce moment visuliser la dynamic range ( je le fait actueelment avec la commande attenidre Anna1 ) en la formattant avec une bordure épaisse en encadré et toutes les bordures à l'intérieur. Donc le format deviendra égalemnt dynamique.

Le but est de recopier la dynamic range par la suite en les nommant Anna 2, Anna 3 etc. Je dois fabriquer des grilles métalliques .Mon format fait un dessin simple avec les dimensions à côté.

Merci d'avance.

 

[vmax01]

Re : format dynamic range

bonsoir le forum et bonsoir jan martens

un petit fichier en PJ serait le bienvenu...... c'est toujours mieux avec un exemple.

bonne soirée.

 

[job75]

Re : format dynamic range

Bonsoir,

Macro à placer dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next 'si le nom "mem1" n'est pas créé
[mem1].Borders.LineStyle = xlNone
ThisWorkbook.Names.Add "mem1", [Anna1] 'nom défini (mémorise)
[Anna1].Borders.Weight = xlMedium
[Anna1].Borders(xlInsideHorizontal).LineStyle = xlNone
[Anna1].Borders(xlInsideVertical).LineStyle = xlNone
End Sub

Crée des bordures "dynamiques" sur la plage Anna1.

Testé sur Excel 2003.

A+

 

[job75]

Re : format dynamic range

Re,

Si l'on veut traiter toutes les plages Anna1 Anna2 Anna3 etc :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nom As Name, n As String
On Error Resume Next 'si un nom n'est pas créé
For Each nom In ThisWorkbook.Names
  If nom.Name Like "Anna#*" Then
    n = Replace(nom.Name, "Anna", "")
    Evaluate("mem" & n).Borders.LineStyle = xlNone
    With Evaluate(nom.Name)
      ThisWorkbook.Names.Add "mem" & n, .Cells 'nom défini (mémorise)
      .Borders.Weight = xlMedium
      .Borders(xlInsideHorizontal).LineStyle = xlNone
      .Borders(xlInsideVertical).LineStyle = xlNone
    End With
  End If
Next
End Sub

A+

 

[job75]

Re : format dynamic range

Re,

Pardon j'avais mal lu :

avec une bordure épaisse en encadré et toutes les bordures à l'intérieur.

Alors utiliser :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nom As Name, n As String
On Error Resume Next 'si un nom n'est pas créé
For Each nom In ThisWorkbook.Names
  If nom.Name Like "Anna#*" Then
    n = Replace(nom.Name, "Anna", "")
    Evaluate("mem" & n).Borders.LineStyle = xlNone
    With Evaluate(nom.Name)
      ThisWorkbook.Names.Add "mem" & n, .Cells 'nom défini (mémorise)
      .Borders.Weight = xlThick 'bordures épaisses
      .Borders(xlInsideHorizontal).Weight = xlThin 'bordures fines
      .Borders(xlInsideVertical).Weight = xlThin
    End With
  End If
Next
End Sub

A+

 

[job75]

Re : format dynamic range

Re,

Sous Excel 2003 pas de problème avec cette macro.

Mais j'ai testé sous Excel 2010, les bordures ne se réduisent pas quand on réduit la plage 😕

J'essaierai de voir ça demain.

A+

 

[job75]

Re : format dynamic range

Bonjour le fil, le forum,

En fait sur Excel 2010 les noms mem1 mem2 mem3... ne pouvaient pas être créés.

Parce que ce sont des références de cellules 😡

Alors je les remplace par memoire1 memoire2 memoire3...

Et j'en profite pour simplifier la manière de créer ces noms :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nom As Name, n As String
Application.ScreenUpdating = False
On Error Resume Next 'si un nom n'est pas créé
For Each nom In ThisWorkbook.Names
  If nom.Name Like "Anna#*" Then
    n = Replace(nom.Name, "Anna", "")
    Evaluate("memoire" & n).Borders.LineStyle = xlNone
    With Evaluate(nom.Name)
      .Cells.Name = "memoire" & n 'nom défini (mémorise)
      .Borders.Weight = xlThick 'bordures épaisses
      .Borders(xlInsideHorizontal).Weight = xlThin 'bordures fines
      .Borders(xlInsideVertical).Weight = xlThin
    End With
  End If
Next
End Sub

A+

 

[job75]

Re : format dynamic range

Re,

Et si A1 et A2 sont renseignées manuellement, il vaut mieux un petit test avec Intersect au départ :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A2]) Is Nothing Then Exit Sub
Dim nom As Name, n As String
Application.ScreenUpdating = False
On Error Resume Next 'si un nom n'est pas créé
For Each nom In ThisWorkbook.Names
  If nom.Name Like "Anna#*" Then
    n = Replace(nom.Name, "Anna", "")
    Evaluate("memoire" & n).Borders.LineStyle = xlNone
    With Evaluate(nom.Name)
      .Cells.Name = "memoire" & n 'nom défini (mémorise)
      .Borders.Weight = xlThick 'bordures épaisses
      .Borders(xlInsideHorizontal).Weight = xlThin 'bordures fines
      .Borders(xlInsideVertical).Weight = xlThin
    End With
  End If
Next
End Sub

A+

 

[job75]

Re : format dynamic range

Re,

Evidemment, si les bordures sont uniquement sur Anna1 Anna2 Anna3, aucun besoin de mémoriser :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A2]) Is Nothing Then Exit Sub
Dim nom As Name
Application.ScreenUpdating = False
On Error Resume Next 'si la plage n'existe pas
Cells.Borders.LineStyle = xlNone 'efface toute bordure de la feuille
For Each nom In ThisWorkbook.Names
  If nom.Name Like "Anna#*" Then
     With Evaluate(nom.Name)
      .Borders.Weight = xlThick 'bordures épaisses
      .Borders(xlInsideHorizontal).Weight = xlThin 'bordures fines
      .Borders(xlInsideVertical).Weight = xlThin
    End With
  End If
Next
End Sub

A+

 

[JNP]

Re : format dynamic range

Bonjour le fil 🙂,
Dis donc, Gérard, t'as la pêche 😛...
Une proposition avec juste une MFC, par contre, je récupère bien la grille, mais pas le contour gras 😱...
Bonne journée 😎