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
ok pour en mettre juste 1 au début.

Par contre j'ai beau mettre ReDim TR(1 To 1000, 1 To 25), ça bug à 1001

ma 1ere partie de tableaux est à récupérer sur la feuil1 et le 2eme tableau sur la Feuil4.

J'ai remarqué aussi qu'il y avait des valeurs doubles
upload_2018-1-19_10-13-39.png


merci et desolé, je cherche et ne trouve pas, je suppose que la réponse et assez évidente pour vous !
 

Dranreb

XLDnaute Barbatruc
Mettez vos listes sous forme de tableaux dans Excel ça vaudra mieux. C'est pas normal que la UsedRange de votre feuille ait autant de lignes.
D'ailleurs TE n'a pas été rechargé à partir d'une autre source pour le dernier tableau ?
 

bennp

XLDnaute Occasionnel
J'ai créé les 2 tableaux comme demandé, d'ailleurs dans mon fichier réel, ils ont des noms définis.
Par contre je vois pas de changement. voici mon fichier en pièce jointe.

il est vrai qu'il y a beaucoup de lignes. j'ai copié /collé les tableaux et je remarque que plus on lance la macro, plus il y a de lignes qui s'ajoutent... (les tableaux ne se mettent plus à la page suivante)

merci
 

Pièces jointes

  • MiseEnPageBennp (1).xlsm
    69.4 KB · Affichages: 25

Dranreb

XLDnaute Barbatruc
Et bien alors faites TE = Feuil1.ListObjects(1).Range.Value tout simplement.
Est-ce normal que ce contenu du tableau TE reste le même pour les outils ?

J'ai bien l'impression qu'il manque un TE = Feuil3.ListObjects(1).Range.Value
(Feuil3 c'est le nom de l'objet Worksheet de la rubrique Microsoft Excel Objets qui assume la représentation auprès de VBA de la feuille Excel nommée "Feuil4")
 
Dernière édition:

bennp

XLDnaute Occasionnel
Non justement le contenu est complètement différent j'ai bien changé avec TE = Feuil1.ListObjects(1).Range.Value pour le 1er tableau et ajouté TE = Feuil3.ListObjects(1).Range.Value pour le 2ème tableau. Dailleurs comment vous savez que c'est Feuil3 qui représente Feuil4, où trouver cette information ?

Mon 2ème tableau n'est pas correct
upload_2018-1-19_20-38-12.png



il devrait être comme ça :

upload_2018-1-19_20-46-45.png


J'ai aussi toujours un problème de saut de page. Pourtant j'ai fait une fusion de lignes comme vous me l'avez conseillez. Ce qui est bizarre c'est que je l'avais plus jusqu'à ce que je copie/colle sur une nouvelle feuille pour supprimer les lignes vides inutiles (d'ailleurs elles sont revenues).

Voici le code :

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.ListObjects(1).Range.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 1000, 1 To 25)
ReDim TR(1 To UBound(TE, 1), 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))
   'ReDim TR(1 To UBound(TE, 1), 1 To 25)
   TE = Feuil3.ListObjects(1).Range.Value
   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

je vous joins aussi mon fichier au cas où

Merci de votre aide
 

Pièces jointes

  • MiseEnPageBennp (1).xlsm
    76.7 KB · Affichages: 20

bennp

XLDnaute Occasionnel
Je souhaiterai faire 2 tableaux différents à partir des mêmes données (dont 1 colonnes en commun). Dois je repasser une des variables intermédiaires (mes informations de base ne seront pas forcement au même endroit dans mon tableau).

Par exemple :
upload_2018-1-30_15-51-14.png


Ne pas faire apparaître la colonne Position. J'ai essayé de créer 2 boucles For C = 1 To 1 puis For C = 3 To 4 mais ça ne fonctionne pas...

je joins le fichier au cas ou

merci pour votre aide
 

bennp

XLDnaute Occasionnel
je dois néanmoins le remplacer par quelque chose ?
Code:
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

ou celui là ?

VB:
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

Et si j'ai des données espacée ?

upload_2018-1-30_21-38-27.png


Je dois pour le coup passer par des variables intermédiaires ? ou juste If Notempty suffit (j'ai d'ailleurs testé mais ça ne fonctionne pas)

Merci
 

Dranreb

XLDnaute Barbatruc
Je n'y comprend plus rien. Sont-ce les outils que vous voulez aussi sortir sans la position ou bien autre chose ?
Évitez d'avoir des données espacées, vous voyez bien que ça complique tout en obligeant à faire un tableau intermédiaire sans espacement.
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 944
Membres
101 849
dernier inscrit
florentMIG