Discussion :

[retraite83]

Bonjour,

grace aux conseils de ce forum j'ai pu obtenir ce que je voulais, c'est à dire adapter automatiquement les hauteurs de ligne des mes feuilles par le code suivant dans la feuille "Services"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
 
Worksheets("Services").Rows("5:43").AutoFit
Worksheets("Rates Services").Rows("5:43").AutoFit
 
For i = 121 To 198
Worksheets("Imprimable").Rows(i).EntireRow.AutoFit
Worksheets("Imprimable").Rows(i).RowHeight = 8 + Worksheets("Imprimable").Rows(i).RowHeight
Next i
 
End Sub

cependant il faut environ 5 secondes à chaque modification d'une cellule de la feuille pour exécuter ce code, et cela risque d'agacer les utilisateurs

Peut-on optimiser ce bout de code qui s'exécute à chaque fois qu'une cellule est modifiée

[patricktoulon]

Bonjour retraité

Worksheets("Services").Rows("5:43").AutoFit
Worksheets("Rates Services").Rows("5:43").AutoFit

For i = 121 To 198
Worksheets("Imprimable").Rows(i).EntireRow.AutoFit
Worksheets("Imprimable").Rows(i).RowHeight = 8 + Worksheets("Imprimable").Rows(i).RowHeight
Next i

ben deja tu pourrais te contenter d'autofiter uniquement la plage utilisée au lieu des rows entieres tu gagnerais pas mal je crois
seule ton height ne pourra etre fait autrement que une par une car elle sont pas toutes de la meme hauteur je supose, si c'est pas le cas un calcule de la premiere appliquée a toutes
et encore etant donné que tu double le height c'est que tu a plusieurs lignes dans une cellules non? c'est pas automatique ca si tu coche ""ajuster automatiquement a la ligne"

[retraite83]

Bonjour Patrick,

en fait la saisie est dans la feuille "Services" ensuite les données sont recopiées par Excel dans les 2 autres feuilles (par =cellule de "Services")

Et je veux que les lignes dans ces 2 autres feuilles s'ajustent aussi en hauteur automatiquement, c'est pour ça que j'ai toutes ces lignes

Bien sur les lignes ont une hauteur variable suivant la longueur du texte saisi

Je double le height avec le +8 pour aérer la mise en page en vue d'une impression via un PDF

[patricktoulon]

je repete autrement
quand tu saisi ta feuille avant de copier tu remplis pas toute la feuille ,seulement ce que tu a besoins pour tableau c'est juste celles ci qui faut autofiter sur les copie

Bien sur les lignes ont une hauteur variables suivant la longueur du texte saisi

ca veux dire que tes cellules sont en mode auto ajustement a la ligne il te faut donc mettre celle qui sont collée dans le meme etat

[retraite83]

Ok je vais étudier cela, tu veux dire qq chose dans ce style ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("Services").Range("B5:E43").AutoFit

En réfléchissant je me dis que je dois pouvoir faire l'autofit uniquement sur la ligne courante à chaque fois puisque la macro est déclenchée à chaque modifs dans une cellule

[patricktoulon]

oui sauf que autofit c'est pour les objects column uniquement
du genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A1:f10").EntireColumn.AutoFit

[retraite83]

j'ai testé, je ne gagne pas de temps,

en fait c'est ma boucle qui prend du temps, sans elle le temps de réponse est quasi-immédiat

Déjà pour optimiser peut on faire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Worksheets("Imprimable").Rows(i).EntireRow.AutoFit
Worksheets("Imprimable").Rows(i).RowHeight = 8 + Worksheets("Imprimable").Rows(i).RowHeight

en une seule ligne? cela optimiserait-t-il ?

[patricktoulon]

non ca sert a rien tu autofit toujours la ligne entiere et puis rows(i).entirerow t'a pas l'impression du pleonasme la

rows(i) designe deja la ligne(i) entiere

[retraite83]

Tu eux dire que je doit mettre seulement pour la première ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("Imprimable").Rows(i).AutoFit

…

[patricktoulon]

re
rows(i) designe deja la ligne(i) entiere pas besoins de entirerow

[eriiic]

Bonjour,

pourquoi traiter toujours 80 lignes alors qu'une seule est changée tel qu'est écrit ton code?
eric

[retraite83]

Oui je me fais la même réflexion, je devrai trouver une solution en calculant les lignes à traiter dans chaque feuille à partir de la ligne courante

[eriiic]

La ligne modifiée ayant provoqué l'événement est Target.Row.
eric

[retraite83]

merci,

pour info est-ce que Target.Row est équivalent à ActiveCell.Row dans ce cas ? A mon avis oui mais…

J'ai erreur 438 Propriété ou méthode non géré par cet objet" dans ma macro sur la ligne autofit, je ne vois pas l'erreur.. (remplacement de la ligne en commentaire qui marche bien)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
Dim actRow As Integer
actRow = Target.Row
Worksheets("F&B").Row(actRow).AutoFit
'Worksheets("F&B").Rows(5).AutoFit
End Sub

[patricktoulon]

re
retraité faudrait d'abords bien memorisé quel object tu utilise

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("F&B").Row(actRow).AutoFit

Row est une propriété qui est un long comme par exemple "10" pour la 10eme pomme

toi tu a un index entre parentheze tu utilise donc l'object collection de ligne "ROWS"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Worksheets("F&B").Rows(actRow).AutoFit

un plus d'attention

[patricktoulon]

re
voici un model qui va autofiter la ligne uniquement sur la plage utilisée sur cette meme ligne
autrement dit au lieu d'autofiter la ligne sur le columns.count du va autofiter seulement les cellule qui sont utilisées et comme j'utilise "entirecolumn" c'est donc toute la plage utilisées de la ligne redimentionnée a toute la colonne entiere

EXEMPLE :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
Dim actRow As Integer
actRow = Target.Row
With Worksheets("F&B")
.Range("A" & actRow, Cells(actRow, .Columns.Count).End(xlToLeft)).EntireColumn.AutoFit
End With
End Sub

OU BIEN ENCORE :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
Dim actRow As Integer
actRow = Target.Row
With Worksheets(1)
.Range("A" & actRow, Cells(actRow, .UsedRange.SpecialCells(xlLastCell).Column)).EntireColumn.AutoFit
End With
End Sub

j'ai testé ca match ca devrait etre bon chez toi aussi


mais entre nous juste pour dire, je me contenterait de faire ceci moi puisque l'evenement est declenché a chaque changement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Range)
With Worksheets("F&B").
Target.EntireColumn.AutoFit 'te redimentionne juste la colonne de la cellule qui vient d'etre modifiée 
End With
End Sub

il faut savoir que quand tu fait
target.entirow.autofit ou range("x,y").entirerow.Autofit ,tu autofit le sheets en entier (soit le nombre de colonnes que posede ta version de excel )

[retraite83]

Merci pour le cours, je note tout ça pour ne pas redemander bêtement la même chose, mais je t'avoue que je suis étonné par la richesse de VBA et par ta compétence...

[patricktoulon]

re
bonjour retraité
je me suis penché aussi sur ton probleme de height sur cellule fusionnée ou pas quand le texte est sur plusieurs lignes
en adaptant une petite fonction que j'ai pour connaitre le nombre de ligne dans une cellule ajustée a la ligne automatiquement je te l'ai transformé en fonction d'ajustement du rowheight

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub testligne3()
    ajuste ([A4:B4])   'devrait donner la meme ligne que la ligne 4 dans la cellule
End Sub
Function ajuste(cel)
    Dim T, i#
    Set T = ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, DisplayAsIcon:=False, Left:=1, Top:=1, Width:=cel.Width, Height:=cel.Height)
    With T
        .Name = "wrapp"
        .Activate
        With .Object
            .Value = cel.Cells(1).Value: .AutoSize = False: .MultiLine = True: .WordWrap = True: .SelectionMargin = False
            .Font.Size = cel.Cells(1).Font.Size: .Font.Name = cel.Cells(1).Font.Name: .Font.Bold = cel.Cells(1).Font.Bold: .Font.Italic = cel.Cells(1).Font.Italic
            For i = .LineCount - 1 To 1 Step -1: .CurLine = .LineCount - i: .SelText = vbCrLf: Next
            lignes = Split(Replace(.Value, vbCrLf & vbCrLf, vbCrLf), vbCrLf)
        End With
        T.Delete
    End With
    cel.Cells(1).RowHeight = cel.Cells(1).RowHeight * IIf(UBound(lignes) > 0, (UBound(lignes) + 1.2), 1)
End Function

demo les cellules A4 et B4 sont fusionées et le texte est sur plusieurs ligne "ajuster a la ligne automatiquement"

bien entendu ca fonctionne aussi sur des cellules non fusionnées