Optimisation de code VBA sur autofit

Version imprimable

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:

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

20/10/2018, 17h17
patricktoulon

re

Bonjour retraité

Citation:

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"
20/10/2018, 17h24
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
20/10/2018, 17h30
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

Citation:

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
20/10/2018, 17h37
retraite83

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

Code:

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
20/10/2018, 17h41
patricktoulon

re

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

Code:

Range("A1:f10").EntireColumn.AutoFit
20/10/2018, 19h16
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:

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 ?
20/10/2018, 21h28
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 :mouarf:

rows(i) designe deja la ligne(i) entiere ;)
20/10/2018, 21h31
retraite83

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

Code:

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

…
20/10/2018, 21h33
patricktoulon

re

re
rows(i) designe deja la ligne(i) entiere :wink: pas besoins de entirerow
21/10/2018, 00h18
eriiic

Bonjour,

pourquoi traiter toujours 80 lignes alors qu'une seule est changée tel qu'est écrit ton code?
eric
21/10/2018, 07h05
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
21/10/2018, 09h18
eriiic

La ligne modifiée ayant provoqué l'événement est Target.Row.
eric
21/10/2018, 09h49
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:

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
21/10/2018, 10h21
patricktoulon

puré

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

Code:

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:

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

un plus d'attention ;)

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:

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:

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:

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 )

21/10/2018, 12h43
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...

1 pièce(s) jointe(s)

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:

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"
Pièce jointe 421147
bien entendu ca fonctionne aussi sur des cellules non fusionnées
;)