Macro pour imprimer d'après une liste de noms

[Buble]

Bonjour le forum,

J'ai 2 feuilles dans mon classeur :
- la première appelée 'LISTE' contient une liste de noms compris entre 1 et 20 placés dans les cellules A2:A21
- La deuxième appelée 'PROJET' contient 6 pages qui s'adaptent aux valeurs du nom sélectionnés en A1 de cette même feuille...

J'aimerais tout simplement lancer une impression des 6 feuilles du 'PROJET' à partir de la feuille 'LISTE' pour la totalité de ma liste...

J'aimerais ne pas à avoir à changer le nom en A1 de la feuille 'PROJET' avant de lancer l'impression...

Merci pour votre aide... Ce gain de temps me serait trop précieux

 

[_Thierry]

Bonjour Buble, le Forum

C'est très simple à mettre en oeuvre et c'est vrai que ça fait gagner un temps fou

Option Explicit


Sub PrintLooping()
Dim Cell As Range
Dim WSSource As Worksheet
Dim WSCible As Worksheet

Set WSSource = Worksheets('LISTE')
Set WSCible = Worksheets('PROJET')


    For Each Cell In WSSource.Range('A2:A21')
        With WSCible
            .Range('A1') = Cell
            .PrintOut
        End With
    Next

End Sub

Bonne Journée (Avec du temps libre j'espère )
[ol]@+Thierry[/ol]

 

[Bufle]

Merci Thierry

J'essaie tout de suite

 

[Bufle]

Rebonjour,

Désolé de vous redéranger mais j'aurais aimer lancer une impression des pages 2 à 7... De plus, à chaque changement de nom l'actualisation des données ne se fait pas... Il faudrait un lancement automatique de F9...

Comment faire ???

Merci encore

 

[_Thierry]

Re Bonjour Buffle

Ah ça tu n'avais pas précisé ' j'aurais aimer lancer une impression des pages 2 à 7'... hmy:

Mais c'est pas grave, à toi d'adapter la Plage concernée qui contient ces pages de la Feuille 'PROJET'...

Pour l'actualisation des formules, 'Calculate' devrait le faire...

Option Explicit


Sub PrintLooping()
Dim Cell As Range
Dim WSSource As Worksheet
Dim WSCible As Worksheet

Set WSSource = Worksheets('LISTE')
Set WSCible = Worksheets('PROJET')


    For Each Cell In WSSource.Range('A2:A21')
        With WSCible
            .Range('A1') = Cell
            .Calculate
            .PageSetup.PrintArea = 'A150:K200' 'A adapter à ta plage contenant
                                                ' les pages 2 à 7...
                                               
            .PrintPreview 'Pour tester sans gaspillage de papier
            '.PrintOut 'Remettre actif ensuite
        End With
    Next

End Sub

Bon Aprèm

[ol]@+Thierry[/ol]

 

[Bufle]

Rebonjour thierry,

C'est la dernière fois que je viens vous déranger... Après mûre réflexion, j'ai pensé qu'il serait plus simple pour moi de lancer l'impression à partir d'une feuille nommée 'IMPRIMER' où je serais en mesure de diriger et contrôler efficacement mon impression...

Pourriez-vous s'il vous plaît y jeter un dernier petit coup d'oeil...

Milles fois Merci [file name=Imprim.zip size=2178]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Imprim.zip[/file]

 

[Fredo]

Je trouve la question de Bufle très intéressante...

Moi aussi elle pourraît m'aider

Merci à tous

 

[_Thierry]

Bonjour Bufle, Fredo

Voici rapidement une adaptation, selon ta Feuille Imprim...

Option Explicit


Sub PrintLooping()
Dim Cell As Range
Dim WSSource As Worksheet
Dim WSCible As Worksheet
Dim PageFrom As Byte, PageTo As Byte, NbCopy As Byte


Set WSSource = Worksheets('IMPRIM')

Set WSCible = Worksheets(CStr(WSSource.Range('C6').Text))

With WSSource
    PageFrom = .Range('C9')
    PageTo = .Range('D9')
    NbCopy = .Range('D6')
End With


    For Each Cell In WSSource.Range('A6:A25')
    If Not Cell = '' Then
        With WSCible
            .Range('A1') = Cell
            .Calculate
            .PrintOut From:=PageFrom, To:=PageTo, Copies:=NbCopy
        End With
    End If
    Next

End Sub

NB il n'y a aucune gestion d'erreur si la Feuille IMPRIM ne contient pas les paramètres nécessaires.

Bonne Journée
[ol]@+Thierry[/ol]

 

[Bufle]

Bonjour,

Merci pour ton travail Thierry, Je vais regarder si cela marche et je vous recontacte rapidement

Merci encore
Bonne journée

 

[Fredo]

Salut à tous les 2,

Le problème posé m'interresse mais j'aurais aimé avoir la possibilité de lancer un autre type d'impression...

L'objectif est de lancer une impression sur plusieurs pages a partir d'une même liste où à une feuille nommée doit correspondre les pages concernées et le nombre de copie...

Je vous joint le fichier avec l'ancienne macro de Bufle... Serait il possible d'y greffer une autre macro correspondant à la deuxième liste...

Merci Thierry [file name=Imprim_20060504135206.zip size=7942]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Imprim_20060504135206.zip[/file]

 

[_Thierry]

Bonsoir Fredo, Bufle, le Forum

Voici une adaptation pour toi Fredo, mais je ne savais pas si tu voulais aussi conserver la boucle sur la Liste de Nom ? (j'ai fait avec... mais sinon il suffit de supprimer la Boucle intérieure 'For Each CellName In RangeListName'...)

Sub PrintLoopingSpecial()
Dim WSSource As Worksheet
Dim WSCible As Worksheet
Dim RangeListName As Range, CellName As Range
Dim RangeParaIni As Range, CellPara As Range
Dim PageFrom As Byte, PageTo As Byte, NbCopy As Byte


Set WSSource = Worksheets('IMPRIM')


With WSSource
    Set RangeParaIni = .Range('G6:G16')
    Set RangeListName = .Range('A6:A25')
End With

For Each CellPara In RangeParaIni
    If Not CellPara = '' Then
       
        Set WSCible = Worksheets(CStr(CellPara))
            NbCopy = CellPara.Offset(0, 1)
            PageFrom = CellPara.Offset(0, 2)
            PageTo = CellPara.Offset(0, 3)
                    For Each CellName In RangeListName
                            If Not CellName = '' Then
                                With WSCible
                                    .Range('A1') = CellName
                                    .Calculate
                                    .PrintOut From:=PageFrom, To:=PageTo, Copies:=NbCopy
                                End With
                            End If
                    Next
      End If
Next
End Sub

Bonne Soirée
[ol]@+Thierry[/ol]