XL 2016 Avis / Aide réécriture code

safranien · Mercredi à 17:09

Bonjour à tous

je vous sollicite pour avoir votre avis sur l'écriture du code du fichier en PJ. Je ne suis pas assidu en VBA et ai essayer de faire au mieux en fonction de ce que je réussissais à trouver sur le forum.

Le but du code est de trouver l'avant dernière ligne de la feuille 1 basé sur la détection de la colonne K qui contient une formule sur toute la colonne. Copier/insérer ligne copiée autant de fois que le nombre saisi dans la msgbox. Et même chose sur la feuille 2. Sachant que la feuille 2 reprend les colonnes de la feuille 1 mais disposées dans un autre ordre. Une formule me récupérant les valeurs de chaque ligne correspondant à l'en-tête de colonne. Donc je peux supprimer ou ajouter les lignes que je veux sur la feuille 1, les données de la ligne 6 de la feuille 1 se retrouveront dans la ligne 6 de la feuille 2 etc.

Le code fonctionne mais je suis preneur de vos corrections plus "pro" qui me permettront également de m'améliorer.

Merci et bonne fin de journée

TooFatBoy · Hier à 17:28

Maintenant qu'on voit un peu mieux ce que tu veux faire, je te propose ceci qui est un récapitulatif des différentes propositions (copie seulement les colonnes voulues, pas besoin de ligne inutilisée en fin de tableau, mise à la hauteur désirée des nouvelles lignes insérées) :

VB:

Sub test1()
'
Dim xCount&, X1&, X2&, X3&
Dim HauteurVoule%

    Application.ScreenUpdating = False

    X1 = Sheets("Feuil1").Cells(Rows.Count, "K").End(xlUp).Row '- 1
    X2 = Sheets("Feuil2").Cells(Rows.Count, "C").End(xlUp).Row '- 1
    X3 = Sheets("Feuil1").Cells(Rows.Count, "G").End(xlUp).Row + 1

    xCount = Application.InputBox("Nombre de lignes", "Saf", , , , , , 1)
    If xCount < 1 Then
        MsgBox "Le nombre de lignes entré est erroné. Veuillez...

TooFatBoy · Hier à 14:23

safranien à dit:
Sauf que j'ai des impératifs de construction du tableau avec des colonnes vides pour séparer et sur ces colonnes vides, il n'y a pas de bordures. Donc je ne peux pas appliquer un code qui va mettre de la bordure sur toutes les cellules. C'est pour cela que je vais chercher l'avant dernière ligne et que j'insère.

Je comprends, quand on a des chefs qui sont un peu stupides et qui ne veulent rien comprendre, on est parfois obligé de faire avec. 🫤

C'est vrai que ton astuce de laisser une ligne vide en bas du tableau est fort... astucieuse. 👍

safranien · Hier à 14:30

TooFatBoy à dit:
Je comprends, quand on a des chefs qui sont un peu stupides et qui ne veulent rien comprendre, on est parfois obligé de faire avec. 🫤

C'est vrai que ton astuce de laisser une ligne vide en bas du tableau est fort... astucieuse. 👍

C'est ça ...

Du coup, si tu as une idée sur l'écriture du code à ajouter pour définir la hauteur des lignes ajoutées ... Et je pense que ça sera bon pour ça.

Phil69970 · Hier à 14:39

@safranien

safranien à dit:
Sauf que j'ai des impératifs de construction du tableau avec des colonnes vides pour séparer et sur ces colonnes vides, il n'y a pas de bordures. Donc je ne peux pas appliquer un code qui va mettre de la bordure sur toutes les cellules. C'est pour cela que je vais chercher l'avant dernière ligne et que j'insère.

J'ai pas tout compris ta réponse de colonne vide mais avec un vrai fichier représentatif cela serait plus simple

Autrement par le code tu peux aller chercher la dernière ligne et la dernière colonne d'une zone comme ceci par exemple :

VB:

Dim Ws1 As Worksheet
Dim Derlig&, Dercol%, Zone As Range

Set Ws1 = Sheets("Feuil1")

Derlig = Ws1.Range("K" & Rows.Count).End(xlUp).Row                      'Derniere ligne de la colonne K (c'est celle qui est rempli jusqu'au bout )
Dercol = Ws1.Cells(5, Ws1.Cells.Columns.Count).End(xlToLeft).Column     'Derniere colonne de la ligne 5 (c'est celle des en têtes)

Set Zone = Ws1.Range(Cells(5, 1), Cells(Derlig, Dercol))

Zone.Borders.LineStyle = 0                                  'Supprime toutes les bordures
Zone.Borders.LineStyle = 1                                  'Création de toutes les bordures
Zone.BorderAround LineStyle:=1, Weight:=xlThick             'Création des bordures extérieures

Pour info :
Sur le fichier que tu as fournit le code précèdent fonctionne.

safranien · Hier à 14:55

Phil69970 à dit:
@safranien

J'ai pas tout compris ta réponse de colonne vide mais avec un vrai fichier représentatif cela serait plus simple

Autrement par le code tu peux aller chercher la dernière ligne et la dernière colonne d'une zone comme ceci par exemple :

VB:

Dim Ws1 As Worksheet Dim Derlig&, Dercol%, Zone As Range Set Ws1 = Sheets("Feuil1") Derlig = Ws1.Range("K" & Rows.Count).End(xlUp).Row 'Derniere ligne de la colonne K (c'est celle qui est rempli jusqu'au bout ) Dercol = Ws1.Cells(5, Ws1.Cells.Columns.Count).End(xlToLeft).Column 'Derniere colonne de la ligne 5 (c'est celle des en têtes) Set Zone = Ws1.Range(Cells(5, 1), Cells(Derlig, Dercol)) Zone.Borders.LineStyle = 0 'Supprime toutes les bordures Zone.Borders.LineStyle = 1 'Création de toutes les bordures Zone.BorderAround LineStyle:=1, Weight:=xlThick 'Création des bordures extérieures

Pour info :
Sur le fichier que tu as fournit le code précèdent fonctionne.

Merci

Colonnes vides :

Mon fichier exemple est bâti selon le besoin exprimé pour éviter de partir trop loin dans des suggestions de faire autrement.

Du coup, le code proposé par TooFatBoy convient. Avec juste maintenant le besoin de définir une hauteur de ligne sur les lignes insérées car ça, je ne l'avais pas prévu avant.

Phil69970 · Hier à 15:19

@safranien

Ton image est très très loin du fichier fournit 😵

Pour la hauteur de ligne 2 solutions (Il y en a surement d'autres)

VB:

Dim Derlig&, Ht%

Derlig = Range("K" & Rows.Count).End(xlUp).Row                      'Derniere ligne de la colonne K (c'est celle qui est rempli jusqu'au bout )

'Solution 1
Ht = Rows(6).RowHeight
Rows(6 & ":" & Derlig).RowHeight = Ht
'Solution 2
Rows(6 & ":" & Derlig).Rows.AutoFit
'Bien sur c'est l'une ou l'autre

safranien · Hier à 15:57

Phil69970 à dit:
@safranien

Ton image est très très loin du fichier fournit 😵

Pour la hauteur de ligne 2 solutions (Il y en a surement d'autres)

VB:

Dim Derlig&, Ht% Derlig = Range("K" & Rows.Count).End(xlUp).Row 'Derniere ligne de la colonne K (c'est celle qui est rempli jusqu'au bout ) 'Solution 1 Ht = Rows(6).RowHeight Rows(6 & ":" & Derlig).RowHeight = Ht 'Solution 2 Rows(6 & ":" & Derlig).Rows.AutoFit 'Bien sur c'est l'une ou l'autre

oui elle est très loin car comme je le disais précédemment, aucun intérêt de mettre toutes les colonnes etc sachant que le principal en rapport avec ma demande est présent :
_ une avant dernière ligne vide
_ la dernière ligne avec la bordure basse épaisse = pourquoi je veux copier l'avant dernière ligne

Ton code pour la hauteur de lignes semble fonctionner mais je ne veux pas toucher à la hauteur de toutes les lignes. C'est un fichier de travail et il est possible que des lignes soient renseignées déjà et ajustées selon le contenu.
Donc je cherche soit à définir la hauteur des lignes insérées soit, en cherchant une autre façon de faire, de définir la hauteur des lignes de la dernière ligne ayant un contenu dans une cellule dans la colonne G à la dernière ligne ayant un contenu dans une cellule de la colonne K.

Dans la capture ci-dessous, j'ai inséré 5 lignes, qui sont les lignes 33 à 37. Soit on peut définir la hauteur de ces lignes insérées. Ou alors on va chercher les lignes 31 à 37 pour définir leur hauteur. La ligne 31 parce que c'est la dernière ligne avec valeur +1 de la colonne G et la ligne 37, qui est la dernière ligne avec valeur de la colonne K.

J'ai tenté d'écrire ainsi mais ça ne fonctionne pas :

VB:

Sub test1()

    Application.ScreenUpdating = False
    
    Dim xCount As Integer
    Dim X1 As Integer
    Dim X2 As Integer
    Dim X3 As Integer
    Dim Derlig1&, Derlig2&, Ht%

Derlig = Range("K" & Rows.Count).End(xlUp).Row

    X1 = Sheets("Feuil1").Cells(Rows.Count, "K").End(xlUp).Row - 1
    X2 = Sheets("Feuil2").Cells(Rows.Count, "C").End(xlUp).Row - 1
    X3 = Sheets("Feuil1").Cells(Rows.Count, "G").End(xlUp).Row + 1
    
    Derlig1 = Range("K" & Rows.Count).End(xlUp).Row + 1
    Derlig2 = Range("G" & Rows.Count).End(xlUp).Row
    Ht = 33.75
    
    xCount = Application.InputBox("Nombre de lignes", "Saf", , , , , , 1)
    If xCount < 1 Then
        MsgBox "Le nombre de lignes entré est erroné. Veuillez recommencer", vbInformation, "Saf"
        GoTo GestionErreur
    End If


    With Sheets("Feuil2")
        .Range("A" & X2 & ":W" & X2).Copy
        .Range("A" & X2 + 1 & ":A" & X2 + xCount).Insert Shift:=xlDown
    End With
    
    With Sheets("Feuil1")
        .Range("A" & X1 & ":W" & X1).Copy
        .Range("A" & X1 + 1 & ":A" & X1 + xCount).Insert Shift:=xlDown
        .Rows(Derlig1 & ":" & Derlig2).RowHeight = Ht
    End With
    
    Range("G" & X3).Select
    
    Application.CutCopyMode = False
    
GestionErreur:
Exit Sub

    
End Sub

Je joins le fichier.

TooFatBoy · Hier à 16:11

Franchement, ça va pas çà... 🙁

Tu ne donnes que des bribes d'informations, et l'image de #19 ne correspond pas du tout aux autres images ni aux fichiers fournis. 🙁 🙁 🙁
Donc impossible de voir ce que tu veux exactement faire et difficile de t'aider.

TooFatBoy · Hier à 16:17

TooFatBoy à dit:
- ne pas mettre une bordure épaisse en bas de la dernière ligne, mais mettre la ligne épaisse en haut de l'après-dernière ligne (mais ce n'est qu'une hypothèse et il faut donc tester pour voir si ça fonctionne),

😲 Visiblement tu n'as pas testé cette proposition 😥, qui semble pourtant fonctionner si j'en crois le test que je viens de faire.

Dans la pièce jointe je copie la dernière ligne du tableau et je l'insère (autant de fois que demandé) entre la dernière ligne du tableau et la ligne située juste en dessous.

safranien à dit:
Du coup, si tu as une idée sur l'écriture du code à ajouter pour définir la hauteur des lignes ajoutées ... Et je pense que ça sera bon pour ça.

TooFatBoy à dit:
Il faudrait ajouter une ligne de code pour modifier la hauteur des lignes insérées.

Une proposition de modification du code pour recopier aussi la hauteur de ligne.

VB:

    With Sheets("Feuil2")
        .Range("A" & X2 & ":K" & X2).Copy
        .Range("A" & X2 + 1 & ":A" & X2 + xCount).Insert Shift:=xlDown
        .Range("A" & X2 + 1 & ":A" & X2 + xCount).RowHeight = .Range("A" & X2).RowHeight
    End With

Phil69970 · Hier à 16:20

@safranien

Tu pars dans tous les sens c'est extrêmement difficile de te suivre
La 1ere partie du code "Test1" n'a pas grand sens mais est ce que tu les comprends ?

Soit tu prends la hauteur d'une ligne de référence à définir c'est la solution 1 avec la ligne 6 de référence mais on peut en choisir une autre

Soit tu auto dimensionne les lignes que tu rajoutes c'est la solution 2 (avec quelques variantes possibles)

Soit tu dis toutes les lignes que je rajoute ont une hauteur de 15 ou 20 ou 30 (hauteur que tu donnes arbitrairement)

TooFatBoy · Hier à 16:24

Phil69970 à dit:
@safranien

Tu pars dans tous les sens c'est extrêmement difficile de te suivre

Je te laisse continuer.

Tschüss
🖖 🌞 🛏

Phil69970 · Hier à 16:36

TFB
Non je suis tout prêt d'abandonner et de me lasser devant tant d'écart entre la demande initial et les images/fichiers fournit et les explications sans compter le code par dessus tête qu'il montre à chaque fois.
Et je ne parle même pas des colonnes vides qui n'ont aucun sens dans le post §19 et il faudrait surement éduquer son chef et lui expliquer qu'excel est capable de faire plein de chose mais vouloir à tout prix casser ses tableaux en petit bout avec des colonnes vides juste pour faire joli n'a aucun sens.

Et savoir que quoique l'on dise il va continuer comme avant j'ai l'impression de perdre mon temps.

TooFatBoy · Hier à 16:45

Phil69970 à dit:
je suis tout prêt d'abandonner et de me lasser devant tant d'écart entre la demande initial et les images/fichiers fournit et les explications et le code par dessus tête qu'il montre à chaque fois.

Effectivement, c'est un peu usant, mais on sait que ça peut arriver.
Et, bien que sachant ça, tu es tout de même là à aider les gens en ayant besoin. 👍

Phil69970 à dit:
Et je ne parle même pas des colonnes vides qui n'ont aucun sens dans le post §19 et il faudrait surement éduquer son chef et lui expliquer qu'excel est capable de faire plein de chose mais vouloir à tout prix casser ses tableaux en petit bout avec des colonnes vides juste pour faire joli n'a aucun sens.

Hélas d'accord avec toi à 100 % mon Phil.

Phil69970 à dit:
Et savoir que quoique l'on dise il va continuer comme avant j'ai l'impression de perdre mon temps.

Je te comprends, mais il n'a visiblement pas trop le choix.
Moi j'envoyais balader mes chefs quand ils me demandaient des bêtises comme ça, ou alors je leur disais que c'était impossible à faire comme ça sous Excel puisqu'ils n'y connaissaient rien. LOL
Bon, je déconseille toutefois cette méthode si on a une famille à nourrir et un patron très bête et méchant.

Phil69970 · Hier à 16:58

TFB

TooFatBoy à dit:
Je te comprends, mais il n'a visiblement pas trop le choix.
Moi j'envoyais balader mes chefs quand ils me demandaient des bêtises comme ça, ou alors je leur disais que c'était impossible à faire comme ça sous Excel puisqu'ils n'y connaissaient rien. LOL
Bon, je déconseille toutefois cette méthode si on a une famille à nourrir et un patron très bête et méchant.

On peut expliquer à son chef qu'il y a bien mieux et plus fonctionnelle sans perdre son poste il me semble, il suffit d’être persuasif et d'expliquer les gains de productivité sur par exemple les stats ou sur la diffusion du tableau à l'externe d'un tableau pro et non pas d'une ~~cochennerie~~ qui fait marrer le client, le fournisseur ou son dirlo destinataire d'un tel fichier.

safranien · Hier à 17:10

wow

Alors pour répondre au mieux. Je n'ai pas l'impression de partir dans tous les sens. Ma demande est claire et la même depuis le début.
Vous m'avez fait des propositions que j'ai essayé de tester mais qui elles, partaient dans des sens différents de ma demande. Et j'avoue ne pas avoir pu tester le "mettre la ligne épaisse en haut de l'après-dernière ligne (mais ce n'est qu'une hypothèse et il faut donc tester pour voir si ça fonctionne)," je suis pris par le temps et les réunions.

La capture d'écran et l'histoire des colonnes vides séparatrices, encore une fois, ça ne changeait en rien à ce que je demandais.

Le fait de vouloir m'orienter sur qqch de différent de ma demande peut être appréciable si ce que je cherche à faire est techniquement irréalisable et si on se concentrait là dessus, on éviterait cette frustration car je ne vais pas sur ce que vous me proposez de différent.

Le code de TooFatBoy fonctionnait et ça m'allait et ça aurait pu se terminer là. Mais avec ce code, j'ai vu que les lignes insérées n'étaient pas à la hauteur voulue et j'ai continué avec cette nouvelle demande. j'aurais effectivement pu m'arrêter mais autant faire qqch d'homogène.

Donc quand Phil dit :

Soit tu prends la hauteur d'une ligne de référence à définir c'est la solution 1 avec la ligne 6 de référence mais on peut en choisir une autre

Soit tu auto dimensionne les lignes que tu rajoutes c'est la solution 2 (avec quelques variantes possibles)

Soit tu dis toutes les lignes que je rajoute ont une hauteur de 15 ou 20 ou 30 (hauteur que tu donnes arbitrairement)

Bah c'est la 3e option que je cherche à faire et je l'ai bien dit, je n'ai jamais parlé des deux premières.

Pour ce qui est d'éduquer mon chef, je vous propose de nous en tenir à l'excel, je pourrai pour le coup me passer de vos conseils à ce sujet là. Mais pour tout expliquer, le problème n'est pas mon chef mais un client exigeant qui veut un affichage de la sorte. Donc ça ne le fait pas marrer non de recevoir ce fichier. Mais peut être avez vous un bon conseil à me donner pour envoyer ch*** un client et lui dire que c est pas faisable ce que je demande alors que ça l'est ?

Bref. Navré si vous êtes agacés mais je suis droit dans ma demande depuis le début.

safranien · Hier à 17:12

Je pense avoir réussi à faire l'ensemble de ce que je voulais. Je partage le code et le fichier si ça peut aider qqun d'autre un jour. Code certainement imparfait à vos yeux mais je vais m'en contenter et arrêter de vous faire perdre plus votre temps.
En tout cas, merci pour votre aide et vos propositions qui m'ont bien orienté.
Bonne soirée

VB:

Sub test1()

    Application.ScreenUpdating = False
   
    Dim xCount As Integer
    Dim X1 As Integer
    Dim X2 As Integer
    Dim X3 As Integer
    Dim Derlig1&, Derlig2&, Ht%

    X1 = Sheets("Feuil1").Cells(Rows.Count, "K").End(xlUp).Row - 1
    X2 = Sheets("Feuil2").Cells(Rows.Count, "C").End(xlUp).Row - 1
    X3 = Sheets("Feuil1").Cells(Rows.Count, "G").End(xlUp).Row + 1   
   
   
    xCount = Application.InputBox("Nombre de lignes", "Saf", , , , , , 1)
    If xCount < 1 Then
        MsgBox "Le nombre de lignes entré est erroné. Veuillez recommencer", vbInformation, "Saf"
        GoTo GestionErreur
    End If


    With Sheets("Feuil2")
        .Range("A" & X2 & ":W" & X2).Copy
        .Range("A" & X2 + 1 & ":A" & X2 + xCount).Insert Shift:=xlDown
    End With
   
    With Sheets("Feuil1")
        .Range("A" & X1 & ":W" & X1).Copy
        .Range("A" & X1 + 1 & ":A" & X1 + xCount).Insert Shift:=xlDown
       
    End With
   
    Derlig1 = Sheets("Feuil1").Range("G" & Rows.Count).End(xlUp).Row + 1
    Derlig2 = Sheets("Feuil1").Range("K" & Rows.Count).End(xlUp).Row
    Ht = 33.75
   
    Sheets("Feuil1").Rows(Derlig1 & ":" & Derlig2).RowHeight = Ht
   
    Range("G" & X3).Select
   
    Application.CutCopyMode = False
   
GestionErreur:
Exit Sub

   
End Sub

XL 2016 Avis / Aide réécriture code

safranien

XLDnaute Occasionnel

Pièces jointes

TooFatBoy

TooFatBoy

XLDnaute Barbatruc

safranien

XLDnaute Occasionnel

Phil69970

XLDnaute Barbatruc

safranien

XLDnaute Occasionnel

Phil69970

XLDnaute Barbatruc

safranien

XLDnaute Occasionnel

Pièces jointes

TooFatBoy

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Pièces jointes

Phil69970

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

safranien

XLDnaute Occasionnel

safranien

XLDnaute Occasionnel

Pièces jointes

Discussions similaires

XL 2016 Avis / Aide réécriture code

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency