Mise en forme conditionnelle de lignes - VBA
Bonjour,
j'ai réussi a faire une mise en forme conditionnelle selon une colonne d'Indice , la police est fixée sur 11 pour toutes les lignes,
Indice 1 : fond gris, ligne fine en haut et en bas
Indice 2 ou 3 : ligne fine claire en haut et en bas
etc...
le problème c'est que je ne peut pas contrôler la grandeur de police, ainsi que la hauteur de ligne,
par exemple :
Indice 1 : fond gris, ligne EPAISSE en haut et FINE en bas + Police = 16 + hauteur ligne fixe = 20 pixel + Ajuster la hauteur de toutes les lignes avec Indice 2 pour ne pas masquer leur contenu.
est ce possible en vba ? mes connaissances en vba sont très limitées, merci
Ci-joint un fichier pour bien expliquer
bonjour, si vous utilisez les numéros de colonne D pour ces MFC ?
le contenu de la colonne D est unique pour chaque ligne, je ne peux pas l'utiliser pours " standardiser " les MFC
bonjour,
pourtant
MFC1 = D-colonne est comme "XX" = contient ni ".", ni "-"
MFC2 = D-colonne est comme "XX." = contient un "."
MFC3 = D-colonne est comme "XX-X" = contient un "-"
les couleurs et les bordeurs rouges y sont pour mieux visualiser les MFC !!! J'ai aussi essayé un style de police "True", mais cela n'a rien fait.
C'est cela que vous voulez.
Voici ce que j'ai obtenu apres avoir ecrit cette macros, a partir de la commande enregistrement de macros et des recherches sur google,
Sub MP()
Dim sh As Worksheet
Dim fin As Long
Dim x As Integer
Set sh = ThisWorkbook.Sheets("BORDEREAU")
For x = 14 To 300
If Cells(x, 2) = 1 Then
Range("D2:I2").Copy
Range(Cells(x, 4), Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Rows(x).RowHeight = Rows(2).RowHeight
End If
If Cells(x, 2) = 2 Then
Range("D3:I3").Copy
Range(Cells(x, 4), Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
If Cells(x, 2) = 3 Then
Range("D4:I4").Copy
Range(Cells(x, 4), Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Rows(x).RowHeight = Rows(4).RowHeight
End If
If Cells(x, 2) = 4 Then
Range("D5:I5").Copy
Range(Cells(x, 4), Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Rows(x).RowHeight = Rows(5).RowHeight
End If
Next x
Cells(1, 1).Select
End Sub
bonjour, c'est un alternatif !
ici c'est parreil, mais peut-être plus facile à manipuler plus tard, quand le nombre de "conditionnelles" augmente
Sub MP()
Dim x As Integer, bHeight
With ThisWorkbook.Sheets("BORDEREAU")
For x = 14 To 300 'boucle ces lignes
bHeight = True 'toujours ajuster l'hauteur de la ligne
Select Case .Cells(x, 2) 'quelle est la valeur de la cellule en colonne B
Case 1: ligne = 2 '>>> format se trouve dans la ligne 2
Case 2: bHeight = False: ligne = 3 '>>> idem ligne 3, mais il ne faut pas ajuster l'hauteur pour ce cas
Case 3: ligne = 4
Case 4: ligne = 5
Case Else: ligne = 0 'avec cette valeur, no copy !!!
End Select
If ligne > 0 Then
.Range("D" & ligne & ":I" & ligne).Copy
.Range(Cells(x, 4), Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
If bHeight Then .Rows(x).RowHeight = .Rows(ligne).RowHeight
End If
Next
Application.Goto .Cells(1, 1), 1
End With
End Sub
Quand je lance l macro, elle bloque sur cette ligne : .Range(Cells(x, 4), Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
bonsoir,
j'ai ajouté une ligne pour mieux savoir la ligne d'erreur et je pense cela a quelque chose à voir avec le variable x
j'ai aussi ajouté un point en face de "Cells", cela correspond avec le with ... end With. Je pense que vous aviez cet erreur quand vous lancez la macro ave une autre feuille active (ne pas Bordereau)
.Range("D" & ligne & ":I" & ligne).Copy
Application.Goto .Cells(x, 1), 1 '>>>> avec ceci il se postionne la ligne du "Paste" en haut pour savoir la ligne d'erreur
.Range(.Cells(x, 4), .Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Merciii ça fonctionne très bien ! en plus c'est res rapide a l'exécution
Bonjour !
Une autre question si possible ,
est ce que c'est possible d'ajouter plus d'espace en haut et en bas de la cellule de la ligne 2 ?
l'ajustement automatique etouffe les données et les rends trop encombrés,
Ajuster automatiquemnt + marge de 0.3 cm en haut et en bas
mercii
bonsoir, on ne peut pas dépasser l'hauteur de 409.5 points (environ 14-15 cm), là-haut, enlarger la colonne ???
Sub MP()
Dim x As Integer, bHeight
With ThisWorkbook.Sheets("BORDEREAU")
For x = 14 To 300 'boucle ces lignes
bHeight = True 'toujours ajuster l'hauteur de la ligne
Select Case .Cells(x, 2) 'quelle est la valeur de la cellule en colonne B
Case 1: ligne = 2 '>>> format se trouve dans la ligne 2
Case 2: bHeight = False: ligne = 3 '>>> idem ligne 3, mais il ne faut pas ajuster l'hauteur pour ce cas
Case 3: ligne = 4
Case 4: ligne = 5
Case Else: ligne = 0 'avec cette valeur, no copy !!!
End Select
If ligne > 0 Then
.Range("D" & ligne & ":I" & ligne).Copy
Application.Goto .Cells(x, 1), 1 '>>>> avec ceci il se postionne la ligne du "Paste" en haut pour savoir la ligne d'erreur
.Range(.Cells(x, 4), .Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
If bHeight Then
.Rows(x).RowHeight = .Rows(ligne).RowHeight
Else 'pour les ligne type "2" !!! 1 cm =28 points alors 2 fois 0.3 = 0.6 cm = 17 points
.Rows(x).AutoFit
.Rows(x).RowHeight = Application.Min(409.5, .Rows(x).RowHeight + 17) 'le max est 409.5, autrement erreur !!!!
If .Rows(x).RowHeight = 409.5 Then .Columns("E").EntireColumn.AutoFit 'Est-ce que ceci (enlarger la colonne) ne cause pas d'autres problèmes ?
End If
End If
Next
Application.Goto .Cells(1, 1), 1
End With
End Sub
je pense que vous devez inspecter les lignes suspectes et intervenir manuellement. Et alors ? diminuer l'hauteur des lettres, enlarger la colonne, je ne le sais pas ? Cela dépend de votre goût ...
Sub MP()
Dim x As Integer, bHeight
With ThisWorkbook.Sheets("BORDEREAU")
For x = 14 To 300 'boucle ces lignes
bHeight = True 'toujours ajuster l'hauteur de la ligne
Select Case .Cells(x, 2) 'quelle est la valeur de la cellule en colonne B
Case 1: ligne = 2 '>>> format se trouve dans la ligne 2
Case 2: bHeight = False: ligne = 3 '>>> idem ligne 3, mais il ne faut pas ajuster l'hauteur pour ce cas
Case 3: ligne = 4
Case 4: ligne = 5
Case Else: ligne = 0 'avec cette valeur, no copy !!!
End Select
If ligne > 0 Then
.Range("D" & ligne & ":I" & ligne).Copy
Application.Goto .Cells(x, 1), 1 '>>>> avec ceci il se postionne la ligne du "Paste" en haut pour savoir la ligne d'erreur
.Range(.Cells(x, 4), .Cells(x, 9)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
If bHeight Then
.Rows(x).RowHeight = .Rows(ligne).RowHeight
Else 'pour les ligne type "2" !!! 1 cm =28 points alors 2 fois 0.3 = 0.6 cm = 17 points
.Rows(x).AutoFit
.Rows(x).RowHeight = Application.Min(409.5, .Rows(x).RowHeight + 17) 'le max est 409.5, autrement erreur !!!!
If .Rows(x).RowHeight = 409.5 Then
.Columns("E").EntireColumn.AutoFit 'Est-ce que ceci (enlarger la colonne) ne cause pas d'autres problèmes ?
With .Cells(x, 4)
'.WrapText = True
.ShrinkToFit = True
End With
s = s & vbLf & x
End If
End If
End If
Next
Application.Goto .Cells(1, 1), 1
End With
If Len(s) Then MsgBox s, vbInformation, UCase("inspecter les lignes suivantes")
End Sub
je ne dois pas elargir la colonne, ça doit respecter le format A4 lors du tirage,