Insérer/Copier/Incrémenter une ligne, Copie de feuille et Lien hypertexte

GTmacrodeb

Expert
Bonjour à toute la communauté,

Nouveau besoin, nouvelle macro, nouveau sujet…

Je souhaite créer une macro que j’affecterai par la suite à un bouton. Cette macro aurait pour principe :
1- Retirer la protection de la feuille
2- Insérer une ligne en-dessous la dernière ligne complétée dans la colonne A.
3- Dans cette ligne insérée : en colonne A poursuivre l’incrémentation, dans les autres colonnes copier/incrémenter les formules et respecter la mise en forme de la ligne précédente pour toutes les cellules.
4- En dessous cette dernière ligne insérée, j’ai des formules avec notamment des sommes en colonne J, je souhaite incrémenter cette formule
5- Dupliquer une feuille masquée du classeur et la placer à la fin. Renommer cette feuille avec la valeur incrémentée en colonne A.
6- Créer un lien hypertexte de la cellule en colonne A vers la feuille correspondante.
7- Remettre la protection de la feuille

J’ai conscience que la route est longue mais je suis toujours motivé pour apprendre et progresser.

Voici le début de code : à noter que pour l'instant je n'ai pas traité la partie Protection de la feuille, ayant déjà pu échanger sur ce point dans d'autres sujets.

Code:
Sub InserLign()

Dim ws_recap As Worksheet
Dim cel_cible As Range
Dim j As Variant

Set ws_recap = Worksheets("Récap")
Set cel_cible = ws_recap.Cells(Rows.Count, 1).End(xlUp).EntireRow

cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

For Each j In Array(2, 3, 4, 5, 6, 7, 9, 10, 11)
   cel_cible.Offset(1, j).FormulaR1C1 = cel_cible.Offset(0, j).FormulaR1C1
Next

End Sub

Ce code me permet d'insérer la ligne en dessous la dernière ligne où la celulle A est non vide.
Par contre, je bloque sur le point 3 de ma macro à savoir l'incrémentation, la copie des formules et la mise en forme.
J'ai une fenêtre avec un message d'erreur avec une croix sur fond rouge 400.

Merci d'avance pour les différents conseils.
 

drul

Obscur pro du hardware
Staff
Salut, pour le point 3 je vois pas ton problème.

Pour le point 4 une slouce simple est "d'agrandir" tes sommes (en gors si tu as des valeures dans les lignes 1 à 9, fais la somme de 1 à 10) comme ça la fonction insert fera toute seule l'incrémentation dans les sommes.
 

GTmacrodeb

Expert
Effectivement c'est ce que j'avais fait au départ (laisser une ligne vide avant la ligne de somme) mais il existe une formule que l'on m'a déjà donné dans un précédent sujet. Je l'adapterai par la suite.

Chaque chose en son temps cependant, pour en revenir au point 3, l'insertion de ligne est OK par contre je ne parviens pas à copier les formules et incrémenter les valeurs de la colonne A.

Et j'ai toujours le message d'erreur, je suppose que le problème est situé sur les lignes 12 à 14.

Petite précision, le message d'erreur dans VB est : "Erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet".
 

drul

Obscur pro du hardware
Staff
Salut, le probleme est en fait en ligne 8:

Enlève le EntireRow et tout ira mieux ...
 

GTmacrodeb

Expert
Merci Drul pour la précision, le message d'erreur est dorénavant résolu.

Alors voici le code que j'ai légèrement modifié.

Code:
Sub InserLign()

Dim ws_recap As Worksheet
Dim cel_cible As Range
Dim j As Variant

Set ws_recap = Worksheets("Récap")
Set cel_cible = ws_recap.Cells(Rows.Count, 1).End(xlUp)

cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown
    For Each j In Array(0, 1, 2, 3, 4, 5, 6, 8, 9, 10)
        cel_cible.Offset(1, j).FormulaR1C1 = cel_cible.Offset(0, j).FormulaR1C1
    Next

End Sub

Pour l'incrémentation des formules cela fonctionne très bien, par contre j'ai une valeur en colonne A (donc Array 0) et je ne trouve pas le moyen pour que sa valeur soit incrémentée (+1) lors de l'insertion de ligne. Actuellement, il me copie la même valeur qu'à la ligne précédente.

Autre point que je souhaite améliorer, la mise en forme qui n'est plus respectée et notamment les bordures.

Merci de votre aide.
 

drul

Obscur pro du hardware
Staff


Salut, sous quelle forme sont les données en A1 (un exemple de valeur serait le bienvenu). Il est probable que devra décomposer la chaine de caractère, faire l'incrémentation, puis la recomposé.

Pour le format, tu peux soit copier les différentes données de formats manuellement. exemple:
Code:
cel_cible.Offset(1, j).Borders.LineStyle = cel_cible.Offset(0, j).Borders.LineStyle

Soit utiliser copy et et pastespeciale
Code:
cel_cible.Offset(0, j).Copy
cel_cible.Offset(1, j).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 

zeb

Modérateur
Un expert programmation (sic) vous déconseille très fortement l'utilisation du presse-papier (copy/paste%) dans les macros.

L'utilisation d'une procédure générique FormatTelleCelluleCommeTelleAutre() pourrait être intéressante...
 

drul

Obscur pro du hardware
Staff


Sur le principe totalement d'accord (tu remarqueras que j'avais proposer une soluce similaire en premier), mais c'est tellement plus rapide d'utiliser pastespecial, que de chercher les 42 priopriétés que tu veux copier pour mettre au format ... (oh le vilain flemmard que je fais :pfff:)
 

zeb

Modérateur
LOL

Alors écrivons FormatTelleCelluleCommeTelleAutre()

:spamafote:
 

GTmacrodeb

Expert
Bonjour à tous les 2,

J'ai essayé d'adapter le code avec la 1ère proposition de drul :
Code:
Dim ws_recap As Worksheet
Dim cel_cible As Range
Dim j As Variant
Dim k As Variant

Set ws_recap = Worksheets("Récap")
Set cel_cible = ws_recap.Cells(Rows.Count, 1).End(xlUp)

cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

For Each j In Array(2, 3, 4, 5, 6, 7, 9, 10, 11)
    cel_cible.Offset(1, j).FormulaR1C1 = cel_cible.Offset(0, j).FormulaR1C1
Next

For Each k In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
    cel_cible.Offset(1, k).Formats = cel_cible.Offset(0, k).Formats
Next

End Sub
Mais cette macro ne réalise pas ce que je souhaite. La copie des formules se retrouve décalée et aucun format n'est copié. :??:

Merci d'avance pour vos conseils.
 

drul

Obscur pro du hardware
Staff
Salut comme dit dans les posts précédents, tu ne peux pas copier tous les éléments de mises en forme d'un coup, il créer une procédure (FormatTelleCelluleCommeTelleAutre() dixit zeb) qui mettra chaque élément de mises en forme 1 à 1 à jour.

Sionon, pourquoi 2 boucles ? sais-tu que tu peux faire plusieurs opérations dans un for ?
(Je vois bien que la plage de la 2eme est plus grande, mais je pige pas pourquoi tu veux mettre en forme des cellules que tu n'as pas modifié ...)
 

GTmacrodeb

Expert
La solution de facilité serait effectivement d'insérer au préalable une ligne vierge supplémentaire en bas du tableau pour que la mise en forme soit faite automatiquement (couleur de fond, bordure...).

Cependant, je trouve dommage de ne pas exploiter les possibilités d'Excel, alors je cherche un moyen pour que la ligne insérée en bas du tableau, ait le même format que la ligne précédente. Car actuellement, les formules sont correctement recopiées mais aucun format n'est appliqué (pas de trame, pas de bordure...).
 

drul

Obscur pro du hardware
Staff
Je répète: fais toi une fonction: FormatTelleCelluleCommeTelleAutre()

Sinon remplacer ta boucle par ceci devrait fonctionner (mais c'est un peu cochon comme méthode)

Code:
For Each j In Array(2, 3, 4, 5, 6, 7, 9, 10, 11)
    cel_cible.Offset(1, j) = cel_cible.Offset(0, j)
    cel_cible.Offset(1, j).Borders.LineStyle = cel_cible.Offset(0, j).Borders.LineStyle
    cel_cible.Offset(1, j).FormulaR1C1 = cel_cible.Offset(0, j).FormulaR1C1
Next

 

GTmacrodeb

Expert
Quand tu dis "C'est un peu cochon", tu n'as pas peur que Z.b (pour ne pas le nommer) vienne faire un rappel à l'ordre ? ...

Je vais tester ce code mais sur ce que je lis, j'ai l'impression qu'uniquement les bordures vont être copiées alors que je souhaiterais une copie complète avec notamment les mises en forme conditionnelles...
 

drul

Obscur pro du hardware
Staff


Non tout sera copier, la première ligne copie le contenu (le texte mais pas la formule) ET la mise en forme, la 2ème ligne copie les bordures, la 3eme ligne copie la formule.
 

GTmacrodeb

Expert
Bonjour et merci pour les précisions !

Alors j'ai utilisé le code proposé pour que la mise en forme soit réalisée, mais en lançant la macro il m'a inséré des bordures différentes (Ex : des bordures en tiret au lieu de lignes pleines).

J'ai essayé d'éditer un autre code (voir ci-dessous) :
Code:
Sub InserLign()

Dim ws_recap As Worksheet
Dim cel_cible As Range
Dim lig_cible As Range
Dim j As Variant

Set ws_recap = Worksheets("Récap")
Set cel_cible = ws_recap.Cells(Rows.Count, 1).End(xlUp)
Set lig_cible = ws_recap.Cells(Rows.Count, 1).End(xlUp).Row

cel_cible.Offset(1).EntireRow.Insert Shift:=xlDown

For Each j In Array(1, 2, 3, 4, 5, 6, 8, 9, 10)
    cel_cible.Offset(1, j).FormulaR1C1 = cel_cible.Offset(0, j).FormulaR1C1
Next

cel_cible.Offset(1).Value = cel_cible.Value + 1

lig_cible.Offset(1).Borders.LineStyle = lig_cible.Borders.LineStyle

End Sub

Mais j'ai un message d'erreur : "Erreur d'exécution '424' : Objet requis".
En point positif tout de même, l'incrémentation fonctionne pour la colonne A.

Je suis favorable à écrire une fonction FormatTelleCelluleCommeTelleAutre(), le seul problème c'est que je ne vois pas comment l'écrire en langage VB. J'ai utilisé l'enregistreur et je me suis retrouvé avec des PasteSpecial, méthode qui a été déconseillée par Zeb auparavant.

Si une piste pouvait m'être indiquée pour la rédaction de cette fonction.

Merci d'avance à tous.
 

zeb

Modérateur
Quand tu dis "C'est un peu cochon", tu n'as pas peur que Z.b (pour ne pas le nommer) vienne faire un rappel à l'ordre ? ...
Zeb est modérateur, ça lui donne le droit de modifier/virer les messages en contradiction avec le règlement. Cette autorité est absolue.
Par ailleurs, il est grande gueule, il s'autorise à ce titre tout ce que vous voudrez bien lui accorder. N'en abusez pas, il aime ça !
Il se trouve cependant que ce type est réputé être un "Expert Programmation", ça lui confère une certaine autorité certes, mais toute relative. Je pense quand même qu'il est de bon conseil.

Donc, non, il ne faut pas avoir peur !

Signé : Anonyme

.
:
:
:
[:patch]
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 128
Messages
6 717 841
Membres
1 586 371
Dernier membre
buntop
Partager cette page
Haut