XL 2016 Passer à la page suivante automatiquement

bennp

XLDnaute Occasionnel
Bonjour,

j'ai un tableau créé en macro, et parfois il se retrouve à la jonction de 2 pages. Quelqu'un aurait une idée pour déplacer automatiquement le tableau à la page suivante ?

Merci
 

bennp

XLDnaute Occasionnel
Le problème est que mes tableaux sont importés de fichiers xml et donc ne peuvent pas être modifiés. J'ai trouvé une solution avec une macro qui remonte toutes les informations avant (je pense pas que ça prenne plus de temps.

Je voudrais aussi copier coller un tableau. J'ai réussi à le faire :

VB:
Sub copier_graph()
    ActiveSheet.ChartObjects(1).Delete
    Worksheets("Feuil6").ChartObjects("Graph_vitrage").Activate
    ActiveChart.ChartArea.Copy
    ActiveSheet.Paste Destination:=Worksheets("Feuil2").Range("B183")
    ActiveSheet.ChartObjects(1).Name = "Graph_vitrage"
End Sub

Le problème est de l'intégrer maintenant dans la macro existante, j'ai testé ça mais bon... comme d'habitude, ça fonctionne pas :

VB:
TE = Feuil6.ChartsObjects(1).Range.Value
    ReDim TR(1 To 100, 1 To 26)
    Worksheets("Feuil6").ChartObjects("Graph_vitrage").Activate
    ActiveChart.ChartArea.Copy
    Set Rng = PlageSuivante(TR, LR)
    LR = 5
    ActiveSheet.Paste

Une idée ?

Merci
 

bennp

XLDnaute Occasionnel
J'ai testé ça :

VB:
    InitialiserMiseEnPage Feuil1.[B128], 40, 5
    Worksheets("Graphique vitrage").ChartObjects("Graphique 1").Activate
    ActiveChart.ChartArea.Copy
   
    Feuil1.Select
    LR = 1
    'TR(1, 1).Select
    'Set Rng = PlageSuivante(TR, LR)
    'Rng(1, 1).Select
   
    ActiveSheet.Paste
   
    'Destination:=Worksheets("Rapport").Range("B183")
    ActiveSheet.ChartObjects(1).Name = "Graphique 1"

J'ai essayé avec le Set Rng = PlageSuivante(TR, LR)

Du coup, j'arrive à coller le graphique mais il est pas très bien placé mais je n'arrive pas à l’intégrer à la suite de mes tableaux
 

bennp

XLDnaute Occasionnel
bonjour,

ça n'a pas l'air de fonctionner, je ne sais pas pourquoi ?
J'ai intégré ce code à la fin avant TerminerMisEenPage :
VB:
 Worksheets("Feuil8").ChartObjects("Graphique 2").Copy Destination:=PlageSuivante(TR, LR)
   
    LR = 1
    ActiveSheet.Paste
   
    'Destination:=Worksheets("Rapport").Range("B183")
    ActiveSheet.ChartObjects(1).Name = "Graphique 2"
ça bug à la 1ère ligne... Par contre je remarque que mon dernier tableau a bien été inséré mais sans mise en forme.

Merci
 

Pièces jointes

  • MiseEnPageBennp.xlsm
    5.4 MB · Affichages: 22

Dranreb

XLDnaute Barbatruc
Bonjour.
Simplifiez la constitution du TR pour les outils :
VB:
Rem. — Outils
TE = Feuil3.ListObjects(1).Range.Value
ReDim TR(1 To UBound(TE, 1) + 5, 1 To 26)
TR(1, 1) = UCase("Liste des outils")
For C = 1 To 4
   TR(4, Choose(C, 1, 24, 25, 26)) = Choose(C, "Outil", "position", "taille", "couleur")
   Next C
LR = 5
For LE = 1 To UBound(TE, 1)
   LR = LR + 1
   For C = 1 To 4
      TR(LR, Choose(C, 1, 24, 25, 26)) = TE(LE, C)
      Next C, LE
Set Rng = PlageSuivante(TR, LR)
Et pour le graphique, le paramètre Destination n'étant pas supporté :
VB:
rem. — Graphique
ReDim TR(1 To 12, 1 To 26)
Set Rng = PlageSuivante(TR, 12)
Feuil8.ChartObjects("Graphique 2").Copy
Rng(1, 1).PasteSpecial
 
Dernière édition:

bennp

XLDnaute Occasionnel
Bonjour,
je relance la discussion, j'essaie de finaliser mon fichier ! J'ai rajouté un bout de code, juste un copié collé, ça fonctionne parfaitement mais la zone d'impression ne se recalcule pas bien et du coup il me manque un bout de texte :

VB:
   ReDim TR(1 To 100, 1 To 26)
  
    LE = 2
   Set Rng = PlageSuivante(TR, LR)
   LTot = Rng.Rows.Count + 1
  
    Range("AC5:BB24").Copy Rng(LTot + 4, 1)
   'Rng(1, 1).Resize(18, 27).Paste
  
    Range("BA8:BB11").Copy
    Rng(LTot + 7, 25).PasteSpecial xlPasteValues

TerminerMiseEnPage
  
End Sub

J'ai essayé aussi sans utiliser le Ltot mais ça ne fonctionne pas. Je ne vois pas ce qui pourrait faire en sorte que la zone d'impression soit bien calculée...

Un idée svp ?

Merci
 

Dranreb

XLDnaute Barbatruc
Bon il y a trop de choses, je ne sais pas où est ce code.
Au lieu de Range("AC5:BB24").Copy ne pourriez vous faire TRés = Range("AC5:BB24").Value
puis Set Rng = PlageSuivante(TRés, Ubound(TRés,1))
Comme ça ça entrerait dans le cadre du suivi automatique du remplissage pour que le TerminerMiseEnPage définisse correctement la zone d'impression à la fin, là où il en est arrivé ?
Parce qui si vous faites des choses en douce en dehors de de sa gestion, comment voulez vous qu'il puisse définir une zone d'impression qui l'englobe ?
 
Dernière édition:

bennp

XLDnaute Occasionnel
Oui ça fonctionne, génial ! Par contre il n'y a pas la mise en forme, je dois la refaire cellule par cellule ou il y a un moyen de le copier du tableau ?

ps: j'ai fait ça :

VB:
 ReDim TR(1 To 100, 1 To 26)
  
    LE = 2
  
    TR = Range("AC3:BB24").Value
    Set Rng = PlageSuivante(TR, UBound(TR, 1))
 

bennp

XLDnaute Occasionnel
Ok ça fonctionne, merci beaucoup !

Une dernière chose j'ai mon tableau du dessus et je souhaite ajouter du texte en dessous, voici le code :

VB:
   TE = Feuil3.ListObjects(1).Range.Value
   ReDim TR(1 To 50, 1 To 26)
LE = 1
    Do:
    TR(1, 1) = UCase("Liste des outils")
    LR = 5: For C = 1 To 4
      TR(LR, Choose(C, 1, 24, 25, 26)) = Choose(C, "Outil", "position", "taille", "couleur")
      Next C
      Do: LR = LR + 1
      For C = 1 To 4
         TR(LR, Choose(C, 1, 24, 25, 26)) = TE(LE, C)
         Next C
      LE = LE + 1: Loop Until LE > UBound(TE, 1)
     
    Set Rng = PlageSuivante(TR, LR)
    LTot = Rng.Rows.Count + 1

   
    With Rng(4, 1).Resize(2, 23)
    .MergeCells = True
    End With
    With Rng(4, 24).Resize(2)
    .MergeCells = True
    .HorizontalAlignment = xlCenter
    End With
    With Rng(4, 25).Resize(2)
    .MergeCells = True
    .HorizontalAlignment = xlCenter
    End With
    With Rng(4, 26).Resize(2)
    .MergeCells = True
    .HorizontalAlignment = xlCenter
    End With

 
    With Rng.Rows(4).Resize(2)
    .Interior.Color = RGB(186, 265, 186)
    .BorderAround ColorIndex:=16
    End With
    With Rng.Rows(4).Resize(LTot - 4)
    .VerticalAlignment = xlCenter
    End With
    With Rng(6, 24).Resize(LTot - 5, 3)
        .NumberFormat = "0.00"
        .HorizontalAlignment = xlCenter
    End With
    Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
    Rng(6, 25).Resize(LTot - 6, 2).Borders(xlInsideVertical).ColorIndex = 16
    Rng(6, 24).Resize(LTot - 6).BorderAround ColorIndex:=16
    With Rng(1, 1)
    .Font.Bold = True
    .Font.Color = RGB(20, 127, 127)
    End With
   
    Rng(LTot + 1, 1).Value = "•    Position : droit ou plat"
    Rng(LTot + 2, 1).Value = "•    Taille : en cm"
    Rng(LTot + 3, 1).Value = "•    couleur: couleur de l'objet"
   Loop Until UBound(TE, 1)

j'y arrive en rajoutant un set mais en l'intégrant directement sous le tableau pour qu'il ne soit pas séparé d'une page, non.

Voici le texte :

• Position : droit ou plat
• Taille : en cm
• couleur: couleur de l'objet

C'est parce que je n'utilise pas le TR ?

Merci
 

Discussions similaires