Mise en forme conditionnelle de lignes - VBA

Le 10/08/2022 à 20:17

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

90454 62cee8f121b57441390446
5mfc-1.zip (495.46 Ko)
Le 10/08/2022 à 20:27

bonjour, si vous utilisez les numéros de colonne D pour ces MFC ?

Le 11/08/2022 à 12:27

le contenu de la colonne D est unique pour chaque ligne, je ne peux pas l'utiliser pours " standardiser " les MFC

Le 11/08/2022 à 17:29

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.

3mfc-1.zip (499.79 Ko)
Le 12/08/2022 à 19:58

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

2test-1.zip (344.28 Ko)
Le 12/08/2022 à 21:06

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
Le 12/08/2022 à 21:26
Mercii,

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
Le 13/08/2022 à 01:21

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
12test-1.zip (348.12 Ko)
Le 15/08/2022 à 11:30

Merciii ça fonctionne très bien ! en plus c'est res rapide a l'exécution

Le 20/08/2022 à 20:14

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

Le 20/08/2022 à 22:42

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
Le 20/08/2022 à 22:56

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
Le 20/08/2022 à 23:10

je ne dois pas elargir la colonne, ça doit respecter le format A4 lors du tirage,

Le 20/08/2022 à 23:22

cela est peut-être un problème au moment d'imprimer. Si on choisit à ce moment qu'on doit ajuster que toutes colonnes pour 1 page.

c'est choisir pour la "moins mauvaise" solution.

image
Rechercher des sujets similaires à "mise forme conditionnelle lignes vba"