Autres Extraire des données et mise en forme de l'impression

Caninge

XLDnaute Accro
Bonjour à tous,

j'ai un fichier à terminer.

Sur la feuille planning individuel j'ai des noms avec l'heure, l'endroit les jours et les tâches à effectuer pour chaque bénévole.
je dois donner à chaque bénévole une feuille de son travail à faire. A découper par la suite.

dans un premier temps comment extraire du planning individuelle chaque nom avec toutes ses tâches qu'il a faire et les disposer
dans la feuille imprimante telle que dans mon exemple.

Et le fin du fin comment faire que sur chaque feuille format A4 en portrait, il faudrait que le nom avec les taches ne soient pas coupés et n'apparaissent
pas sur deux feuilles.

Ouh là j'ai l'impression que je m'explique mal. Je ne sais pas si vous allez me comprendre mais pas par contre je suis persuadé que vous trouverez la solution.

Merci de m'aider

CANINGE
 

Pièces jointes

  • Extraction de données et format imprimante V1.xlsm
    51.6 KB · Affichages: 16

job75

XLDnaute Barbatruc
Bonjour Caninge,

Les choses les plus simples étant les meilleures je mettrais simplement ce code dans la 1ère feuille :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 3 Or Target.Column <> 2 Or Target(1) = "" Then Exit Sub
Cancel = True
With Me.PageSetup
    .PrintTitleRows = "$2:$2"
    .PrintArea = Target.CurrentRegion.Address
End With
Me.PrintPreview 'aperçu avant impression
End Sub
La macro se déclenche avec un double-clic sur un nom/prénom en colonne B.

A+
 

Pièces jointes

  • Extraction de données et format imprimante(1).xlsm
    57.5 KB · Affichages: 10

Caninge

XLDnaute Accro
Bonjour Job,

on se connait il me semble.

ce n'est pas tout fait ce que je voudrais

en fait la disposition des données dans la feuille Planning individuel se transforme si j'ose dire comme dans la feuille Imprimante.
avec à chaque personne ou bénévole VIN SCENES EN BOURBONNAIS et Observation accompagné des petits points
une nouvelle disposition des données en quelque sorte.
A plus
 

job75

XLDnaute Barbatruc
Voyez ce fichier (2) et la nouvelle macro :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 3 Or Target.Column <> 2 Or Target(1) = "" Then Exit Sub
Cancel = True
Rows(2).Hidden = False 'affiche
With Me.PageSetup
    .PrintTitleRows = "$2:$3"
    .PrintArea = Target.CurrentRegion.Resize(, 6).Address
End With
Me.PrintPreview 'aperçu avant impression
Rows(2).Hidden = True 'masque
End Sub
 

Pièces jointes

  • Extraction de données et format imprimante(2).xlsm
    58.3 KB · Affichages: 7

Caninge

XLDnaute Accro
Mais Job75

je peux comprendre que vous voulez modifier mon fichier à votre façon.
mais comme je veux donner à chaque bénévole une feuille comme dans mon exemple,
je ne peux reprendre votre solution.

mais ce n'est pas grave Job75, ce forum est fait pour s'expliquer et pour aussi pour aider certaines personnes
comme moi qui sont limitées avec Excel.

je suis incapable de faire une macro parce que je n'ai pas appris mais j'aimerais bien.

A plus merci et bonne soirée.
 

job75

XLDnaute Barbatruc
Bon je suis arrivé à faire quelque chose d'assez simple avec la feuille "Imprimante" :
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Row < 3 Or Target.Column <> 2 Or Target(1) = "" Then Exit Sub
Dim P As Range, c As Range, n&
Cancel = True
Set P = Target.CurrentRegion
With Sheets("Imprimante")
    .[B6] = Target
    .Range(.Rows(8), .[B:B].Find("Observation*", , xlValues)(0)).Delete 'RAZ
    .Rows(8).Resize(5 * P.Rows.Count).Insert 'insertion de lignes
    For Each c In P.Columns(2).Cells
        .Cells(8 + n, 2).Resize(4) = Application.Transpose(c.Resize(, 4))
        n = n + 5
    Next
    .PageSetup.PrintArea = "" 'zone d'impression inutile
    .PageSetup.FitToPagesWide = 1 '1 page en largeur
    .PageSetup.FitToPagesTall = 1 '1 page en hauteur
    Application.ScreenUpdating = False
    .PrintPreview 'aperçu avant impression
End With
End Sub
Fichier (3).

Bonne nuit.
 

Pièces jointes

  • Extraction de données et format imprimante(3).xlsm
    61.5 KB · Affichages: 11

Caninge

XLDnaute Accro
Bonjour Job75,

c'est pas mal votre proposition. Maintenant est-ce possible en cliquant ou même sans cliquer d'avoir les 4 bénévoles l'un en dessous de l'autre
avec à chaque fois l'entête "VIN SCENES EN BOURBONNAIS" et en évitant que la fiche individuelle soit coupée en apparaissant sur 2 feuilles.
Il y a 200 bénévoles à notre manifestation.
une question idiote : si je prends des cours de programmation EXCEL, il me faudra combien de temps pour manier cet outil correctement ?

A plus
 

job75

XLDnaute Barbatruc
Bonjour Caninge, le forum,

Afficher tous les noms paraît difficile, de plus c'est inutile puisque vous avez dit :
je dois donner à chaque bénévole une feuille de son travail à faire.
Par contre il est facile de faire une impression en boucle, je vais vous la faire.

Pour la programmation il faut être patient, sûrement quelques années sont nécessaires.

Mais tout dépend de vos capacités de raisonnement logique : sur XLD même après des années d'expérience certains continuent de très mal programmer.

Bonne journée.
 

job75

XLDnaute Barbatruc
Voyez ce fichier (4) avec le choix de l'impression par 2 boutons :
VB:
Private Sub CommandButton1_Click() 'Imprimer la sélection
Imprimer True
End Sub

Private Sub CommandButton2_Click() 'Imprimer tout
Imprimer False
End Sub

Sub Imprimer(choix As Boolean)
Dim r As Range, P As Range, n&, c As Range
Set r = Range("B3:B" & Rows.Count)
If Application.CountA(r) = 0 Then Exit Sub 'si le tableau est vide
If choix Then
    ActiveCell.Activate 'au cas où la sélection est un objet
    Set r = Intersect(Selection, r)
    If r Is Nothing Then Exit Sub
    Set r = IIf(r.Count = 1, r.Resize(2), r) 'au moins 2 cellules
End If
Application.ScreenUpdating = False
With Sheets("Imprimante")
    .PageSetup.PrintArea = "" 'zone d'impression inutile
    .PageSetup.FitToPagesWide = 1 '1 page en largeur
    .PageSetup.FitToPagesTall = 1 '1 page en hauteur
    For Each r In r.SpecialCells(xlCellTypeConstants)
        Set P = r.CurrentRegion
        .Cells(6, 2) = r
        .Range(.Rows(8), .Columns(2).Find("Observation*", , xlValues)(0)).Delete 'RAZ
        .Rows(8).Resize(5 * P.Rows.Count).Insert 'insertion de lignes
        n = 0
        For Each c In P.Columns(2).Cells
            .Cells(8 + n, 2).Resize(4) = Application.Transpose(c.Resize(, 4))
            n = n + 5
        Next c
        If choix Then .PrintPreview Else .PrintOut
    Next r
End With
End Sub
 

Pièces jointes

  • Extraction de données et format imprimante(4).xlsm
    70.7 KB · Affichages: 17

Caninge

XLDnaute Accro
rebonjour Job75,

C'est pas mal. Je voulais savoir si les 4 fiches (bénévoles) s'imprimaient les unes après les autres et sur une feuille pour chacun d'eux quand on clique sur le bouton imprimer tout. Je ne peux pas faire un essai, je ne suis pas chez moi pour l'instant et je n'ai pas d'imprimante sous la main.
S'il y avait un aperçu avant cela serait pas mal.

A plus
 

Caninge

XLDnaute Accro
Bonjour Job75,

je ne ferai pas l'impression chez moi sinon ma cartouche va être vide en peu temps.
Il est prévu d'enregistrer toutes les feuilles en PDF, de mettre tout ça sur une clé USB et de faire imprimer
les feuilles dans un magasin. J'ai mis en PDF, cela fonctionne mais n'ayant qu'un bénévole je vais devoir prendre toutes
les feuilles une par une. Mais bon ce n'est pas impossible, je vais prendre mon temps.
A moins que vous me trouviez une solution. je suis embêtant non ?
merci
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 920
Membres
101 840
dernier inscrit
SamynoT