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
Vous êtes sûr qu'on peut le faire avec les TS, parce que les valeurs de mon tableau en Feuil1 ne sont pas alignées, si on peut le faire, où placer le code svp ? j'ai essayé de plusieurs façon mais ça ne fonctionne pas !

merci encore
 

bennp

XLDnaute Occasionnel
Bonjour,

j'essaie d'ajouter un tableau à la suite de la macro (différent et plus facile), j'ai commencé à modifier la macro que vous faite pour les autres tableaux et je suis bloqué. Pour l'instant j'essaie juste de créer le tableau sans le mettre à la suite des autres,

ce tableau est juste une copie d'une autre feuille avec ajout de titre et titre de colonnes.

upload_2018-1-4_9-17-28.png


VB:
Option Explicit

Sub TableauOutil() ' Le blanc souligné est à réserver aux noms des procédures évènements
                   ' comme séparateur entre le nom de l'objet et le nom de l'évènement.
Dim TE(), LE&, TS(), LS&, TR(), LR&, C&, Nom As String, Rng As Range, LTot&
TE = Sheets("Feuil4").UsedRange.Value
ReDim TS(1 To 1000, 1 To 4)
For LE = 2 To UBound(TE, 1)
   If Not IsEmpty(TE(LE, 2)) Then
      LS = LS + 1
        TS(LS, 1) = TE(LE, 1)
        TS(LS, 2) = TE(LE, 2)
        TS(LS, 3) = TE(LE, 3)
        TS(LS, 4) = TE(LE, 4): End If
   Next LE
ReDim TR(1 To 50, 1 To 26)

InitialiserMiseEnPage Feuil1.[B134], 43, 4
LS = 1
Do: Nom = TS(LS, 1): TR(1, 1) = UCase(Nom)
   LR = 3: For C = 1 To 4
      TR(LR, Choose(C, 1, 20, 24, 25)) = Choose(C, "Outil", "position", "taille", "couleur")
      Next C
   Do: LR = LR + 1
      For C = 1 To 4
         TR(LR, Choose(C, 1, 20, 24, 25)) = TS(LS, C + 1)
         Next C
      LS = LS + 1: Loop Until TS(LS, 1) <> Nom
    Set Rng = PlageSuivante(TR, LR)
    LTot = Rng.Rows.Count + 1
    With Rng.Rows(3)
        .RowHeight = 30
        .Interior.Color = RGB(186, 255, 186)
        .VerticalAlignment = xlCenter
        .BorderAround ColorIndex:=16
    End With
    Rng(3, 23).Resize(, 3).WrapText = True
  
    With Rng(3, 23).Resize(LTot - 2, 3)
        .NumberFormat = "0.00"
        .HorizontalAlignment = xlCenter
    End With
    Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
    Rng(4, 22).Resize(LTot - 4, 4).Borders(xlInsideVertical).ColorIndex = 16
    Rng(LTot, 23).Resize(, 3).BorderAround ColorIndex:=16
    Rng(1, 1).Font.Bold = True
   Loop Until IsEmpty(TS(LS, 1))
TerminerMiseEnPage
End Sub
 

Pièces jointes

  • MiseEnPageBennp (1).xlsm
    2.9 MB · Affichages: 27

Dranreb

XLDnaute Barbatruc
Bonjour.
Il ne faut pas changer la hauteur des ligne d'entêtes.
Au pire fusionnez les cellules sur 2 lignes.
Si les données d'entrées ont une structure correcte et sont correctement classées vous n'avez plus besoin d'un tableau intermédiaire TS. Vous pouvez travailler directement avec le tableau d'entrée TE
 

bennp

XLDnaute Occasionnel
Bon, comme toujours j'arrive à rien pourtant j'y passe du temps pour essayer... j'ai réussi à copier le tableau mais comme les colonnes sont écartées dans le tableau qui doit être collé, ça ne fonctionne pas, surtout que je ne sais plus quelle variable doit encore être présente (en sachant que ce tableau vient à la suite des autres tableaux avec comme titre "Détails des outils".

Est-il possible encore une fois que vous me proposiez un code à la suite de l'autre pour l'intégrer à ma page, ça me permettra d'y voir plus clair sur les futurs tableaux que je dois aussi insérer.

Desolé d'être insistant mais je n'y arrive vraiment pas.

Merci d'avance
 

Dranreb

XLDnaute Barbatruc
Pourquoi n'y arrivez vous pas ?
Il ne faut pas vous laisser arrêter par un indice en dehors des limites par exemple.
Cherchez d'où ça vient et corrigez.
Virez le chargement de TS qui ne sert à rien dans ce cas et utilisez TE dans la suite.
Remarque : vous aurez aussi un indice en dehors des limites.
Mettez des espions pour déboguer.
 

bennp

XLDnaute Occasionnel
j'ai fait pas mal de modifs :
VB:
Option Explicit

Sub TableauOutil() ' Le blanc souligné est à réserver aux noms des procédures évènements
                   ' comme séparateur entre le nom de l'objet et le nom de l'évènement.
Dim TE(), LE&, TS(), LS&, TR(), LR&, C&, Nom As String, Rng As Range, LTot&
TE = Sheets("Feuil4").UsedRange.Value
ReDim TR(1 To 1000, 1 To 4)

'For LE = 2 To UBound(TE, 1)
    'LR = LR + 1
    'TR(LR, 1) = TE(LE, 1)
    'TR(LR, 2) = TE(LE, 2)
    'TR(LR, 3) = TE(LE, 3)
    'TR(LR, 4) = TE(LE, 4)
   
   'Next LE
ReDim TR(1 To 50, 1 To 25)

InitialiserMiseEnPage Feuil1.[B134], 43, 5
LE = 1
    Do: 'Nom = TE(LE, 1): TR(1, 1) = "test"
   
    LR = 3: For C = 1 To 4
      TR(LR, Choose(C, 1, 20, 24, 25)) = Choose(C, "Outil", "position", "taille", "couleur")
      Next C
      Do: LR = LR + 1
      For C = 1 To 4
         TR(LR, Choose(C, 1, 23, 24, 25)) = TE(LE, C + 1)
         Next C
      LE = LE + 1: Loop Until IsEmpty(TE(LE, 1))
     
     
    LTot = Rng.Rows.Count + 1
    With Rng.Rows(3)
        .RowHeight = 30
        .Interior.Color = RGB(186, 255, 186)
        .VerticalAlignment = xlCenter
        .BorderAround ColorIndex:=16
    End With
    Rng(3, 23).Resize(, 3).WrapText = True
    With Rng(3, 23).Resize(LTot - 2, 3)
        .NumberFormat = "0.00"
        .HorizontalAlignment = xlCenter
    End With
    Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
    Rng(4, 22).Resize(LTot - 4, 4).Borders(xlInsideVertical).ColorIndex = 16
    Rng(LTot, 23).Resize(, 3).BorderAround ColorIndex:=16
    Rng(1, 1).Font.Bold = True
   Loop Until IsEmpty(TE(LE, 1))
TerminerMiseEnPage
End Sub

j'ai supprimé les TS, gardé les TR (pour déplacer les colonnes) je sais pas si je dois garder les 2 Do: ?
ça reste flou pour moi. J'ai un problème sur cette ligne là (l'indice n'appartient pas à la sélection)
VB:
TR(LR, Choose(C, 1, 23, 24, 25)) = TE(LE, C + 1)


Merci pour vos conseils en tout cas, ça m'aide à y voir plus clair !
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Remplacez IsEmpty(TE(LE, 1)) par LE > UBound(TE, 1)
Vous n'utilisez jamais PlageSuivante ? Vos tableaux TR n'y seront jamais versés !
Vous en mettez du temps à comprendre que quand C vaut 4, C + 1 est supérieur à UBound(TE, 2) !
 

bennp

XLDnaute Occasionnel
Merci pour votre aide, ça n'était pas très clair, et même quand vous me le dites, j'ai du mal à saisir... Bref c'est bon mon code est correct :

VB:
Option Explicit

Sub TableauOutil() ' Le blanc souligné est à réserver aux noms des procédures évènements
                   ' comme séparateur entre le nom de l'objet et le nom de l'évènement.
Dim TE(), LE&, TS(), LS&, TR(), LR&, C&, Nom As String, Rng As Range, LTot&
TE = Sheets("Feuil4").UsedRange.Value
ReDim TR(1 To 1000, 1 To 4)
ReDim TR(1 To 50, 1 To 25)

InitialiserMiseEnPage Feuil2.[B134], 43, 5

LE = 1
    Do:
    TR(1, 1) = UCase("Liste des outils")
    LR = 5: For C = 1 To 4
      TR(LR, Choose(C, 1, 21, 24, 25)) = Choose(C, "Outil", "position", "taille", "couleur")
      Next C
      Do: LR = LR + 1
      For C = 1 To 4
         TR(LR, Choose(C, 1, 21, 24, 25)) = 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, 18)
    .MergeCells = True
    End With
    With Rng(4, 19).Resize(2, 5)
    .MergeCells = True
    .HorizontalAlignment = xlCenter
    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.Rows(4).Resize(2)
    .Interior.Color = RGB(186, 255, 186)
    .VerticalAlignment = xlCenter
    .BorderAround ColorIndex:=16
    End With
   
    With Rng(6, 19).Resize(LTot - 2, 7)
        .NumberFormat = "0.00"
        .HorizontalAlignment = xlCenter
    End With
    Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
    Rng(6, 24).Resize(LTot - 6, 2).Borders(xlInsideVertical).ColorIndex = 16
    Rng(6, 19).Resize(LTot - 6, 5).BorderAround ColorIndex:=16
    With Rng(1, 1)
    .Font.Bold = True
    .Font.Color = RGB(20, 127, 127)
    End With
   Loop Until UBound(TE, 1)
TerminerMiseEnPage
End Sub

Maintenant je souhaiterais l'ajouter à la suite du code, que me conseillez vous svp :
- coller ce code à la suite en sachant que les variables ne pourront pas être utilisées pour les 2 parties
- appeler la macro, en redéfinissant : InitialiserMiseEnPage Feuil2.[B134], 43, 5 avec un row.count je suppose. (si c'est ce cas de figure, pourriez vous me donner la bonne ligne de code svp ?)

Ps : pouvez vous m'expliquer pourquoi j'ai dû mes Resize(Ltot- (4 au début, puis 6..)
alors que la valeur Ltot est a priori constante = 10)

merci beaucoup
 

Dranreb

XLDnaute Barbatruc
Bonjour.
La première solution avec un seul InitialiserMiseEnPage au début et un seul TerminerMiseEnPage à la fin, et en utilisant les mêmes variables devrait être bonne.
La valeur LTot n'est pas constante, elle dépend de LR au moment de l'appel à PlageSuivante
Si vous n'avez à le faire qu'une fois vous n'avez plus besoin de 2 boucles imbriquées une pour explorer l'ensemble et une autre plus interne pour détecter les changements de paquets. Une seule suffit avec For LE = 2 To UBound(TE, 1) puis LR = LE + 5
 
Dernière édition:

bennp

XLDnaute Occasionnel
Bonjour,

desolé de revenir aussi tard..
Ltot est utilisé plusieurs fois plus je dois insérer plusieurs tableaux différents.
en ce qui concerne justement d'ajouter les 2 macros, j'ai bien fait comme vous me l'avez conseillez :

VB:
Option Explicit

Sub TableauParoi() ' Le blanc souligné est à réserver aux noms des procédures évènements
                   ' comme séparateur entre le nom de l'objet et le nom de l'évènement.
Dim TE(), LE&, TS(), LS&, TR(), LR&, C&, Nom As String, Rng As Range, LTot&

TE = Feuil1.UsedRange.Value
ReDim TS(1 To 1000, 1 To 5)

For LE = 2 To UBound(TE, 1)
   If Not IsEmpty(TE(LE, 2)) Then
      LS = LS + 1
      TS(LS, 1) = TE(LE, 1)
      TS(LS, 2) = TE(LE, 2): End If
   If Not IsEmpty(TE(LE, 3)) Then TS(LS, 3) = TE(LE, 3) * 100
   If Not IsEmpty(TE(LE, 4)) Then TS(LS, 4) = TE(LE, 4)
   If Not IsEmpty(TE(LE, 5)) Then TS(LS, 5) = TE(LE, 5)
  
   Next LE
ReDim TR(1 To 50, 1 To 25)

InitialiserMiseEnPage Feuil2.[C134], 39, 5
LS = 1
Do: Nom = TS(LS, 1): TR(1, 1) = UCase(Nom)
  
   LR = 3: For C = 1 To 4
      TR(LR, Choose(C, 1, 23, 24, 25)) = Choose(C, "Fruit", "épaisseur (cm)", "Chiffre", "Clé")
      Next C
   Do: LR = LR + 1
      For C = 1 To 4
         TR(LR, Choose(C, 1, 23, 24, 25)) = TS(LS, C + 1)
         Next C
      LS = LS + 1: Loop Until TS(LS, 1) <> Nom
    Set Rng = PlageSuivante(TR, LR)
    LTot = Rng.Rows.Count + 1
    With Rng(LTot, 20)
    .Value = "  TOTAL"
    .Font.Bold = True
    End With
    Rng(LTot, 20).Resize(, 3).BorderAround ColorIndex:=16
    Rng(LTot, 23).FormulaR1C1 = "=SUM(R[-" & LTot - 4 & "]C:R[-1]C)"
    Rng(LTot, 24).FormulaR1C1 = "=SUM(R[-" & LTot - 4 & "]C:R[-1]C)"
    Rng(LTot, 25).FormulaR1C1 = "=SUM(R[-" & LTot - 4 & "]C:R[-1]C)"
   
    With Rng(2, 1).Resize(2, 22)
    .MergeCells = True
    End With
    With Rng(2, 23).Resize(2)
    .MergeCells = True
    .HorizontalAlignment = xlCenter
    End With
    With Rng(2, 24).Resize(2)
    .MergeCells = True
    .HorizontalAlignment = xlCenter
    End With
    With Rng(2, 25).Resize(2)
    .MergeCells = True
    .HorizontalAlignment = xlCenter
    End With
   
    With Rng.Rows(2).Resize(2)
        '.RowHeight = 30
        .Interior.Color = RGB(186, 255, 186)
        .VerticalAlignment = xlCenter
        .BorderAround ColorIndex:=16
    End With
   
    Rng(LTot, 20).Resize(, 3).Interior.Color = RGB(186, 255, 186)
    With Rng(3, 23).Resize(LTot - 2, 3)
        .NumberFormat = "0.00"
        .HorizontalAlignment = xlCenter
    End With
    Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
    Rng(4, 22).Resize(LTot - 4, 4).Borders(xlInsideVertical).ColorIndex = 16
    Rng(LTot, 23).Resize(, 3).BorderAround ColorIndex:=16
    Rng(1, 1).Font.Bold = True
   Loop Until IsEmpty(TS(LS, 1))
  
   LE = 1
    Do:
    TR(1, 1) = UCase("Liste des outils")
    LR = 5: For C = 1 To 4
      TR(LR, Choose(C, 1, 21, 24, 25)) = Choose(C, "Outil", "position", "taille", "couleur")
      Next C
      Do: LR = LR + 1
      For C = 1 To 4
         TR(LR, Choose(C, 1, 21, 24, 25)) = 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, 18)
    .MergeCells = True
    End With
    With Rng(4, 19).Resize(2, 5)
    .MergeCells = True
    .HorizontalAlignment = xlCenter
    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.Rows(4).Resize(2)
    .Interior.Color = RGB(186, 255, 186)
    .VerticalAlignment = xlCenter
    .BorderAround ColorIndex:=16
    End With
   
    With Rng(6, 19).Resize(LTot - 2, 7)
        .NumberFormat = "0.00"
        .HorizontalAlignment = xlCenter
    End With
    Rng.Rows(4).Resize(LTot - 4).BorderAround ColorIndex:=16
    Rng(6, 24).Resize(LTot - 6, 2).Borders(xlInsideVertical).ColorIndex = 16
    Rng(6, 19).Resize(LTot - 6, 5).BorderAround ColorIndex:=16
    With Rng(1, 1)
    .Font.Bold = True
    .Font.Color = RGB(20, 127, 127)
    End With
   Loop Until UBound(TE, 1)
TerminerMiseEnPage
'Call TableauOutil
End Sub

j'ai un message d'erreur sur cette ligne --> TR(LR, Choose(C, 1, 21, 24, 25)) = TE(LE, C)
j'ai essayé de changer la variable mais ça ne fonctionne pas non plus

Merci

Ben
 

bennp

XLDnaute Occasionnel
Oui merci j'avais pas vu. Effectivement ça dépasse !

si je change les valeurs ça bug toujours :
ReDim TR(50 To 100, 1 To 25)
j'ai constaté que LR se finissait à 138

Que dois-je faire ? Renommer le ReDim au début ? en ajouter un nouveau avant la crétion du 2ème tableau.
Redéfinir le Tr avec une autre variable ?

merci
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 786
Membres
101 817
dernier inscrit
carvajal