XL 2010 Macro pour modifier les params d'impression ?

[ManuXZ]

Bonsoir la communauté!!! ;-))

Je dois modifier les paramètres d'impression pour imprimer des invitations.
Au départ, j'avais commencé à créer une macro "à la mano" (qui ne fonctionnait pas....:-(() et je me suis dit ,
mais bien sûr !!! , utilisons l'enregistreur de macro !!! ; il m'a généré une macro (params complets d'édition !!! (je n'ai donc conservé que les lignes qui m'intéressaient !) mais snif, cela ne modifie pas plus les params d'impression...

PS: Il faut:
1/ saisir le nbre d'invitations,
2/ cliquer sur bouton "effacer feuille3" puis
3/ sur le bouton "edition feuille3"
4/ et je vais dans menu, fichier, imprimer
mais je constate que les marges personnalisées n'ont pas été changées ???

La macro :Result-final

Auriez-vous qqs idées ?

Merci bcp pour votre aide! (sûrement un truc tout bête !!;-)) )

 

[Franc58]

Je parlais d'un code pour copier le logo autant de fois que nécessaires et aux bons endroits, que tu pourrais éventuellement nous donner (perso, je ne sais pas faire ça).
Mais Franc58 vient de nous en donner un.

---

Franc58 j'aime bien ton code. D'autant qu'il me permet d'apprendre comment il faut procéder pour la copie d'une image.
J'ai juste une question : si on sort le .Copy et le CutCopyMode=False de la boucle, est-ce que ça fonctionne toujours ?

Tu as raison, distraction de ma part. J'aurais dû le mettre avant la boucle, juste après le Set. Quant au CutCopyMode = False, c'est un réflexe de ma part, je le mets chaque fois que je fais une copie pour éviter de voir les pointillés de sélection autour d'une cellule, on peut s'en passer ici.

 

[TooFatBoy]

Tu as raison, distraction de ma part. J'aurais dû le mettre avant la boucle, juste après le Set.

OK. Merci pour ta réponse.
Donc si ça marche en ne faisant le Copy qu'une seule fois, avant la boucle For, ça doit faire gagner un peu de temps d'exécution.

Quant au CutCopyMode = False, c'est un réflexe de ma part, je le mets chaque fois que je fais une copie pour éviter de voir les pointillés de sélection autour d'une cellule, on peut s'en passer ici.

Oui, moi aussi je le mets après un Copy pour enlever les pointillés.
Je parlais de ne l'exécuter qu'une seule fois, juste après le Next. Mais si on peut carrément s'en passer, c'est encore mieux.

 

[patricktoulon]

re

Donc si ça marche en ne faisant le Copy qu'une seule fois, avant la boucle For, ça doit faire gagner un peu de temps d'exécution.

ben de tout facon le copy n'est neccessaire qu'une fois avant la boucle sur les feuilles
ca devrait donner un truc du genre

dim Sh as worksheet,shap as shape
mashape.copypicture
for each sh in worksheets
sh.pictures.paste
set shap= sh.shapes(sh.shapes.count)
PlaceTheShapeInCenterRange sh.range("xx:yy"), shap,5    '5% de marge
next

 

[ManuXZ]

Donc :
- remettre une indentation totalement farfelue alors que ça avait été corrigé pour rendre le code plus lisible,
- supprimer les sauts de page manuels permettant de bien réaligner l'impression toutes les trois invitations,
- remettre l'instruction totalement inutile de mise en forme de chaque cellule comportant le numéro d'invitation,
- ne déclarer qu'une seule des deux variables de la macro,
- remettre 7 ou 8 modules qui ne servent à rien puisqu'ils sont vides,
- etc.,
c'est ça que tu appelles une "optimisation", si je comprends bien.

On ne doit pas avoir la même notion d'optimisation...


J'attends de voir comment tu vas optimiser le code des collègues pour recopier l'image.

Bsoir
Je ne comprends pas bien la version que tu as récupérée car j'ai bien ton code optimisé sur la mienne ?
avec l'incrémentation optimisée, j'ai bien que 2 macros, etc,......

 

[ManuXZ]

Salut, voici comment recopier le logo, je l'ai renommé "Logo" dans le classeur plutôt que "Objet 166", pour plus de clarté, donc change le nom de l'image dans le classeur ou dans le code de la macro comme tu veux. Testé et fonctionne.

Sub Result_Final()

 Dim NbInvit As Integer
 Dim Logo As Shape
 
 ' récupération du nbre invitations saisies
 NbInvit = Feuil1.Range("B25")
 
 ' Suppression de tous les shapes dans la "Feuil3"
 For Each shp In Feuil3.Shapes
     shp.Delete
 Next shp
 
 ' Remise à zéro de la "Feuil3"
 Feuil3.Columns("A:G").Clear

 ' Génération des invitations dans la feuille ("Feuil3") à partir du modèle ("Feuil2")
 Feuil2.Range("A1:G18").Copy Feuil3.Range("A1").Resize(18 * NbInvit)
 Feuil3.Columns("G").Cells.HorizontalAlignment = xlLeft
 
 ' Copie du logo dans chaque document généré
 Set Logo = Feuil2.Shapes("Logo")
 For Invit = 1 To NbInvit - 1
     Logo.Copy
     Feuil3.Paste Feuil3.Cells((18 * Invit) + 1, 1)
     Application.CutCopyMode = False
 Next Invit
 
 ' Incrémentation du numéro d'invitation toutes les 18 lignes
 For Invit = 1 To NbInvit
     Feuil3.Cells(18 * Invit - 16, 7).NumberFormat = "00"
     Feuil3.Cells(18 * Invit - 16, 7) = Invit
 Next Invit
 
 ' Modification des params d'impression en mettant à ZERO (TopMargin, BottomMargin, HeaderMargin, FooterMargin)
 With Worksheets("Feuil3").PageSetup
   .LeftMargin = Application.CentimetersToPoints(0.7)
   .RightMargin = Application.CentimetersToPoints(0.7)
   .TopMargin = Application.CentimetersToPoints(0)
   .BottomMargin = Application.CentimetersToPoints(0)
   .HeaderMargin = Application.CentimetersToPoints(0)
   .FooterMargin = Application.CentimetersToPoints(0)
   .Orientation = xlPortrait
   .PaperSize = xlPaperA4
 End With

End Sub

Bsoir , merci bcp pour tes infos !!!! , je suis novice sur Excel ...;-)) , donc j'ai récupéré un classeur et lorsque je clique sur le logo j'ai (=INCORPORER("Paint.Picture" ) mais je n'ai pas bien compris ce que je dois mettre ds le code à la place ("Logo") pour que cela fonctionne , je ne sais pas où se trouve cette image sous excel ???

 

[TooFatBoy]

Je ne comprends pas bien la version que tu as récupérée car j'ai bien ton code optimisé sur la mienne ?
avec l'incrémentation optimisée, j'ai bien que 2 macros, etc,......

Je l'ai récupéré... sur le forum : c'est le dernier fichier que tu as posté dans ce fil.
Je confirme qu'il n'y a que 2 macros, d'où ma remarque sur les 7 modules inutiles car vides.

Ton code initial :

Spoiler: Ton code initial

Sub Result_Final()

 Dim var1 As Integer
 
 ' récupération du nbre invitations sasies
 var1 = Feuil1.Range("B25")
 var1 = var1 - 1

' Recopie du modèle (Feuil2)  dans la Feuil3

 Feuil2.Range("A1:G20").Copy Feuil3.Range("A1")
 
' Génération des invitations ds la feuille3 à partir du modèle recopié
 
 If var1 > 0 Then
     Feuil3.Range("A1:F18").Copy Feuil3.Range("A19").Resize(18 * var1)
 End If
 
'---------------------------------------------------------------------------
 


 Feuil3.Cells(2, 7).NumberFormat = "00"
 
 Feuil3.Columns("G").Cells.HorizontalAlignment = xlLeft
 
 Feuil3.Cells(2, 7).Value = 1
 n = 2
 
 ' Incrémentation compteur invitation toutes les 18 lignes x nbre d'invits
 
 For invit = 1 To var1
  
     Feuil3.Cells(n + 18, 7).NumberFormat = "00"
  
     Feuil3.Cells(n + 18, 7) = Feuil3.Cells(n, 7) + 1
  
     n = n + 18
  
 Next invit
 
 
' Modification des params d'impression en mettant à ZERO (TopMargin, BottomMargin, HeaderMargin, FooterMargin)
 
  With Worksheets("Feuil3").PageSetup
      .LeftMargin = Application.CentimetersToPoints(0.7)
      .RightMargin = Application.CentimetersToPoints(0.7)
      .TopMargin = Application.CentimetersToPoints(0)
      .BottomMargin = Application.CentimetersToPoints(0)
      .HeaderMargin = Application.CentimetersToPoints(0)
      .FooterMargin = Application.CentimetersToPoints(0)
      .Orientation = xlPortrait
      .PaperSize = xlPaperA4
  End With

 
End Sub

Mon code à moi pondu par moi-même, que c'est moi que je l'ai moi-même posté dans ce fil :

Spoiler: Mon code à moi pondu par moi-même, que c'est moi que je l'ai moi-même posté dans ce fil

Sub Result_Final()
'
Dim NbInvit As Long, Invit As Long

    ' Récupération du nombre d'invitations saisi
    NbInvit = Feuil1.Range("B25").Value

    ' Remise à zéro de la feuille de CodeName "Feuil3"
    Feuil3.Columns("A:G").Clear

    ' Génération des invitations dans la feuille de CodeName "Feuil3" à partir du modèle (feuille de CodeName "Feuil2")
    Feuil2.Range("A1:G18").Copy Feuil3.Range("A1").Resize(18 * NbInvit)

    For Invit = 1 To NbInvit
        ' Incrémentation du numéro d'invitation toutes les 18 lignes
        Feuil3.Cells(18 * Invit - 16, 7) = Invit
        ' Ajout d'un saut de page manuel toutes les 3 invitations
        If (Invit Mod 3 = 0) And (Invit < NbInvit) Then Worksheets("Feuil3").Rows(18 * Invit + 1).PageBreak = xlPageBreakManual
    Next Invit
 
    ' Modification des paramètres d'impression
    With Worksheets("Feuil3").PageSetup
        .PaperSize = xlPaperA4
        .Orientation = xlPortrait
        .LeftMargin = Application.CentimetersToPoints(0.7)
        .RightMargin = Application.CentimetersToPoints(0.7)
        .TopMargin = Application.CentimetersToPoints(0)
        .BottomMargin = Application.CentimetersToPoints(0)
        .HeaderMargin = Application.CentimetersToPoints(0)
        .FooterMargin = Application.CentimetersToPoints(0)
        .CenterHorizontally = True
        .CenterVertically = True
    End With

End Sub

et le code une fois optimisé par toi :

Spoiler: le code une fois optimisé par toi

Sub Result_Final()

 Dim NbInvit As Integer
 
 ' récupération du nbre invitations saisies
 NbInvit = Feuil1.Range("B25")

 
 
    ' Remise à zéro de la "Feuil3"
    Feuil3.Columns("A:G").Clear
  

    ' Génération des invitations dans la feuille ("Feuil3") à partir du modèle ("Feuil2")
    Feuil2.Range("A1:G18").Copy Feuil3.Range("A1").Resize(18 * NbInvit)




 
  Feuil3.Columns("G").Cells.HorizontalAlignment = xlLeft
 
 
   ' Incrémentation du numéro d'invitation toutes les 18 lignes
 
   For Invit = 1 To NbInvit
 
         Feuil3.Cells(18 * Invit - 16, 7).NumberFormat = "00"
 
         Feuil3.Cells(18 * Invit - 16, 7) = Invit
  
    Next Invit
 
 
 
' Modification des params d'impression en mettant à ZERO (TopMargin, BottomMargin, HeaderMargin, FooterMargin)
 
  With Worksheets("Feuil3").PageSetup
      .LeftMargin = Application.CentimetersToPoints(0.7)
      .RightMargin = Application.CentimetersToPoints(0.7)
      .TopMargin = Application.CentimetersToPoints(0)
      .BottomMargin = Application.CentimetersToPoints(0)
      .HeaderMargin = Application.CentimetersToPoints(0)
      .FooterMargin = Application.CentimetersToPoints(0)
      .Orientation = xlPortrait
      .PaperSize = xlPaperA4
  End With

 
End Sub

Mais bon, peu importe. Tant que ton classeur fonctionne comme tu veux, c'est le principal.

 

[Franc58]

Bsoir , merci bcp pour tes infos !!!! , je suis novice sur Excel ...;-)) , donc j'ai récupéré un classeur et lorsque je clique sur le logo j'ai (=INCORPORER("Paint.Picture" ) mais je n'ai pas bien compris ce que je dois mettre ds le code à la place ("Logo") pour que cela fonctionne , je ne sais pas où se trouve cette image sous excel ???

Je ne comprends pas, c'est toi qui fournis le classeur avec l'image et tu ne sais pas où elle est ???
Tu dis que quand tu cliques sur le logo tu as (=INCORPORER("Paint.Picture"), c'est ça l'image. Je te mets en pj le classeur avec le logo et la macro.

 

[patricktoulon]

bonjour
de toute facon c'est bien mal pensé ce truc
les sauts de pages te coupent le logo dès la 3eme page

si bien que finalement on comprend plus ce que tu cherche faire vraiment

alors je vais essayer de comprendre
tu a une feuille 1 dans la quelle tu entre des données
ces données sont transférées dans la feuille 2
la plage de la feuille2 est copiée en feuille 3 à la suite

je dirais l'art et la manière de faire du tricotage

mon opinion
tu jette ta feuille 3
tu copie 10 fois /100 fois la plage de la feuille2 à la suite dans ta feuille 2
tu nomme tes plage
dans ton code tu injecte les donné dans ta boucle plage 1 2 etc...
terminé
et tu memo le nombre de tour de boucle et tu imprime de la page 1 à nombre de tour de boucle

il faudra m'expliquer aussi pourquoi mettre une image en activX au lieu d'une simple picture
sachant que pour les déléter c'est compliqué selon les versions d'excel

jette tout et refait tout proprement ça ira plus vite

terminé

 

[ManuXZ]

Je ne comprends pas, c'est toi qui fournis le classeur avec l'image et tu ne sais pas où elle est ???
Tu dis que quand tu cliques sur le logo tu as (=INCORPORER("Paint.Picture"), c'est ça l'image. Je te mets en pj le classeur avec le logo et la macro.

Merci cela fonctionne (en laissant Logo) !!
désolé pour mes questions naïves mais tu m'avais dit de mettre à la place de "Logo" le nom de l'image (et donc j'avais mis "paint.picture") mais lors de l' exécution, il plantait sur cette ligne.

C'est un classeur que j'ai récupéré de quelqu'un d'autre , j'ai donc recopié ce classeur chez moi mais
désolé je n'ai tjrs pas compris où se trouvait cette image dans le classeur...??? c'est vraiment mystérieux for me :-0.
Bref ça marche !!!

 

[ManuXZ]

bonjour
de toute facon c'est bien mal pensé ce truc
les sauts de pages te coupent le logo dès la 3eme page

si bien que finalement on comprend plus ce que tu cherche faire vraiment

alors je vais essayer de comprendre
tu a une feuille 1 dans la quelle tu entre des données
ces données sont transférées dans la feuille 2
la plage de la feuille2 est copiée en feuille 3 à la suite

je dirais l'art et la manière de faire du tricotage

mon opinion
tu jette ta feuille 3
tu copie 10 fois /100 fois la plage de la feuille2 à la suite dans ta feuille 2
tu nomme tes plage
dans ton code tu injecte les donné dans ta boucle plage 1 2 etc...
terminé
et tu memo le nombre de tour de boucle et tu imprime de la page 1 à nombre de tour de boucle

il faudra m'expliquer aussi pourquoi mettre une image en activX au lieu d'une simple picture
sachant que pour les déléter c'est compliqué selon les versions d'excel

jette tout et refait tout proprement ça ira plus vite

terminé

Entièrement d'accord avec toi , je peux virer une feuille !!! ;-)) pour faire bcp + simple !!!

 

[patricktoulon]

comme ça vite fait
j'ai mis ton logo en picture
j'ai viré ta feuille3
je fait tout sur la feuille 2(effacer et inscrire)
tu peux imprimer 2 invites par feuille A4
si tu veux une seule par feuille(pas economique) tu chande 2 pour 1 dans le test if i mod

 

[TooFatBoy]

tu peux imprimer 2 invites par feuille A4

Ah, toi aussi tu fais dans l'optimisation : avant on pouvait imprimer 3 invitations par page, mais maintenant on est passé à 2...


Plus sérieusement, je pense que tu t'es encore gouré sur une borne : j'ai demandé 10 "places" et il m'en imprime 11.

si tu veux une seule par feuille(pas economique) tu chande 2 pour 1 dans le test if i mod

C'est déjà à 1. Donc ça n'imprime qu'une seule invitation par page.

 

[patricktoulon]

ben tu met 3 mais tu met 97% a ajuster a la page dans les param imprimantes
cela dit
il y a un soucis et de taille
quand je fait

 .Range("G2,F4,A8,C10,C12,C13,A16,A18") = ""

ca déformate les cellules(font, bold ,etc...) ca les défusionne aussi
alors que ça ne devrait pas

je cherche même plus à comprendre
encore un fichier 2010 ou 2021 ou 365
mon code le voici ( faites avec ou pas)

Sub clearPage()
    With Feuil2
        derlig = .Cells(Rows.Count, "A").End(xlUp).Row
        If derlig = 18 Then Exit Sub
        .Range("A19:A" & derlig).EntireRow.Delete
        For I = Feuil2.Shapes.Count To 2 Step -1: DoEvents: Feuil2.Shapes(I).Delete: Next
        .Range("G2,F4,A8,C10,C12,C13,A16,A18") = ""
    End With
End Sub


Sub createcopy()
   Dim F As Worksheet, plage1 As Range, I&, cel As Range, cell As Range, A&
   clearPage
    Set F = Feuil2
    Set plage1 = F.[A1:G19]
    'ecriture des données
    With F
        .[A8] = Feuil1.[b4]
        .[c10] = Feuil1.[b7]
        .[c12] = Feuil1.[b10]
        .[c13] = Feuil1.[b13]
        .[A16] = Feuil1.[B19]
        .[A18] = Feuil1.[B22]
    End With
    nombre = Feuil1.[b25]

    For I = 1 To nombre - 1
        Set cel = F.Range("A" & (19 + 1) * I)
        plage1.Copy cel
        F.Shapes(I + 1).Top = cel.Top + 10
        F.Shapes(I + 1).Left = 15
      If I Mod 3 = 0 Then F.HPageBreaks.Add Before:=cel ' 1 invit par feuille A4 (mettre mod 2 pour imprimer deux invit par feuille)
     Next
    For Each cell In F.Range("F1").Resize(19 * I)
        If cell <> "" Then A = A + 1: cell.Offset(, 1) = A
    Next
F.PrintPreview

End Sub

 

[TooFatBoy]

quand je fait

.Range("G2,F4,A8,C10,C12,C13,A16,A18") = ""

ca déformate les cellules(font, bold ,etc...) ca les défusionne aussi
alors que ça ne devrait pas

Ben déjà, pourquoi fais-tu = "" au lieu du traditionnel ClearContents ?

 

[patricktoulon]

re
par ce qe clearcontents déformate et défusionne aussi
tout du moins sur ce fichier
quand je teste sur un fichier 2013 ca le fait pas
comme je l'ai dis encore un fichier 20210 ou 2021 ou 365

jai toujours des soucis avec des fichiers provenant de ces versions (sans très grand importance certes) mais qui me brise bien les coucou...ttes