XL 2016 Passer à la page suivante automatiquement

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))
 

Dranreb

XLDnaute Barbatruc
Alors si vous ne pouvez la refaire comme pour d'autre tableaux copiez là et utilisez Rng.PasteSpecial xlPasteFormats
 

bennp

XLDnaute Occasionnel
VB:
Rng.PasteSpecial xlPasteFormats = PlageSuivante(TR, UBound(TR, 1))
est mis en rouge. Même si je mets seulement Rng.PasteSpecial xlPasteFormats avant ou apres le Set, ça ne fonctionne pas
 

Dranreb

XLDnaute Barbatruc
La syntaxe n'est pas bonne.
Éventuellement :
VB:
Set Rng = Range("AC3:BB24")
TR = Rng.Value
Rng.Copy
PlageSuivante(TR, UBound(TR, 1)).PasteSpecial xlPasteFormats
 

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
 

Dranreb

XLDnaute Barbatruc
Mettez un maximum de chose dans le tableau TR. L'accès au coup par coup aux cellule c'est quand on ne peut pas faire autrement, pour les formats. Là je pens que vous avez un problème parce que vous définissez LTot = Rng.Rows.Count + 1 et beaucoup plus bas jusqu' à Rng(LTot + 3, 1).Value = "• couleur: couleur de l'objet" ce qui dépasse de 2 lignes la dernière plage qui a été définie par PlageSuivante(TR, LR). Mettez tout ça ensemble avant de le faire et incrémentez s'il y a lieu LR pour que vos textes y soient contenus.
 

bennp

XLDnaute Occasionnel
Comme je dois mettre ces phrases en dessous, je me suis dit qu'il fallait d'abord incrémenter le tableau puisque je ne sais pas combien de ligne j'aurai dans le tableau. Donc si je l’intègre avant LTot = Rng.Rows.Count + 1, ça veut dire que je dois utiliser que TR et non LTot. Mais du coup je ne sais pas à quelle ligne je devrais l'intégrer...
si je copie les phrases dans mon tableau d'origine, je ne pourrais pas les copier il me semble...

Ps : comme toujours j'essaie d'y comprendre quelque chose mais ça reste très flou... :)
 

Dranreb

XLDnaute Barbatruc
si vous ajouter à LR le nombre de lignes qu'il faudra pour les contenir avant appel à Plage Suivante, il faudra naturellement diminuer d'autant LTot.
 

bennp

XLDnaute Occasionnel
ok merci j'ai réussi :

VB:
   TE = Feuil3.ListObjects(1).Range.Value
   ReDim TR(1 To 50, 1 To 26)
   InitialiserMiseEnPage Feuil2.[B134], 39, 5
LE = 1
    Do:
    TR(1, 1) = UCase("Liste des outils")
    LR = 6: For C = 1 To 4
      TR(LR - 4, 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 - 4, 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
    Rng(LTot - 3, 1).Value = "•    Position : droit ou plat"
    Rng(LTot - 2, 1).Value = "•    Taille : en cm"
    Rng(LTot - 1, 1).Value = "•    couleur : couleur de l'objet"
    Rng(LTot, 1).Value = "•    couleur2 : couleur de l'objet"
   
   

   Loop Until UBound(TE, 1)
 

Dranreb

XLDnaute Barbatruc
Bonjour.
Je ne comprends pas pourquoi vous tenez à écrire vos 4 lignes dans Rng après PlageSuivante au lieu de les écrire dans TR avant de le faire.
 

bennp

XLDnaute Occasionnel
Bonjour,

Je n'avais pas vu le message précédent... Je n'ai pas saisi comment écrire dans TR. Je ne suis pas sûr que ça fasse accélérer la macro surtout avec la mise en page. Dites moi si je me trompe.

J'ai une autre demande du même genre :

Je souhaiterais ajouter un paragraphe supplémentaire "Images particulières" en fonction de telle ou telle case cochée :

upload_2018-10-31_15-26-31.png

Si la case est cochée, afficher le texte et l'image associée :

VB:
     ReDim TR(1 To 100, 1 To 26)
  
    LE = 2
    TR(1, 1) = UCase("Images particuliéres")
   Set Rng = PlageSuivante(TR, LR)
   LTot = Rng.Rows.Count + 1
  
    If Range("AC27") = True Then
    Range("AF27").Copy
    Rng(4, 25).PasteSpecial xlPasteValues
    Rng(6, 24).activSheet.Pictures("arbre").Value
   
    End If
J'ai donné un nom aux images mais ça n'a pas l'air de fonctionner, je sais pas si je dois ajouter les images dans ImageOgject avnt...

Tu sais pourquoi ça ne fonctionne pas ?

Merci

Ben
 

Fichiers joints

Dranreb

XLDnaute Barbatruc
Bonjour.
En tout cas un Range n'a pas de propriété activSheet. Il a une propriété Worksheet qui est un objet Worksheet représentant la feuille contenant la plage représentée par le Range.
 

bennp

XLDnaute Occasionnel
OK par contre si je remplace activesheet par worksheet, ça fonctionne pas. Je sais pas si c'est une bonne idée de charger les images en objet... Je sais pas si tu te souviens mais la taille des lignes ne peut pas être modifiée pour éviter que le saut de page se fasse bien. Je sais pas non plus si l'image doit être à l'intérieur de la cellule pour quelle soit affichée. Tu pourrais me proposer un code ?

Merci d'avance
 

Dranreb

XLDnaute Barbatruc
Ça doit être du genre FeuilleDesImage.Shapes("NomDeLImage").Copy: Rng.Workseet.Paste: With Rng.Worksheet.Shapes(Rng.Worksheet.Shapes.Count): .Left = Rng(x, y).Left: .Top = etc. … End With
 

bennp

XLDnaute Occasionnel
J'ai essayé ça :
VB:
     ReDim TR(1 To 100, 1 To 26)
  
    LE = 2
    TR(1, 1) = UCase("Images particuliéres")
   Set Rng = PlageSuivante(TR, LR)
   LTot = Rng.Rows.Count + 1
   Sheets("Feuil2").Shapes("Image 5").Copy: Rng.Workseet.Paste: With Rng.Worksheet.Shapes(Rng.Worksheet.Shapes.Count): .Left = Rng(6, 8).Left:
   End With
ça bug... je sais pas si je dois remplir les top, right, etc

Peut-etre que je dois mettre un Rbg(x,y) à plusieurs endroits ?

Merci de ton aide en tout cas !!
 

bennp

XLDnaute Occasionnel
J'ai bien sûr déjà essayé l'enregistreur avant mais ça ne m'aide pas beaucoup puisque je souhaite afficher une image à un endroit qui dépend d'une variable et en plus cela doit être affiché seulement si la case est cochée... Je me trompe ?
Même quand je fais juste un simple copier coller, je ne retrouve pas la fonction shape.
 

Dranreb

XLDnaute Barbatruc
Il n'y a pas de fonction shape c'est un type d'objet. Il y a la collection Shapes de ces objets.
Pour faciliter la mise au point ne mettez peut être pas, séparées par des ': ', toutes les instructions sur la même ligne.
 

bennp

XLDnaute Occasionnel
Ok, il manquait juste une lettre :

VB:
     ReDim TR(1 To 100, 1 To 26)
  
    LE = 2
    TR(5, 1) = UCase("Images particuliéres")
   Set Rng = PlageSuivante(TR, LR)
   LTot = Rng.Rows.Count + 1
   If Range("AC27") = True Then
   Sheets("Feuil2").Shapes("Image 5").Copy
   Rng.Worksheet.Paste
   With Rng.Worksheet.Shapes(Rng.Worksheet.Shapes.Count)
   .Left = Rng(10, 21).Left
   End With
    Range("AF27").Copy
    Rng(10, 8).PasteSpecial xlPasteValues
   
    End If
par contre je ne comprends pas pourquoi "arbre" et l'image ne sont pas sur la même ligne.

Autre chose, je souhaite que le texte et l'image apparaissent seulement si la case est cochée. Mais si la 1ére n'est pas cochée, je veux que les informations soient remontées et pas qu'il y ait de l'espace. Je pense que si je fais comme ça , ça ne fonctionnera pas. Doit-on passer par un tableau intermédiaire pour çà ?

Merci

BEn
 

Discussions similaires


Haut Bas