Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel impression selon une liste de fichiers et d'onglets

impression selon une liste de fichiers et d'onglets

16 réponses
Avatar
Gilles72
Bonjour à tous,
ci dessous le code qui pemet d'ouvrir et d'imprimer des fichiers, selon une
liste établie par une autre macro.
j'aimerais changer la ligne de code qui imprime pour qu'elle prenne en
compte le nom des onglets à imprimer dans chaque fichier.
ex:
En colonne A: le chemin complet du fichier (fait par la macro)
En colonne F: FEUIL!1(ajoute sur le tableau)
En colonne F: FEUIL!4
En colonne F: FEUIL!8

Sub imprim() 'ça marche

Application.EnableEvents = False

On Error Resume Next

Dim Cal As Range, c As Range, Ligne As Long

Sheets(liste).Select

Set Cal = Range("A1:A12")

[A1].Select

For Each c In Cal

If c = "" Then Exit For

Workbooks.Open Filename:=c

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Application.DisplayAlerts = False

ActiveWorkbook.Close

Next c

End Sub

si kekun(e) a une suggestion , merci d'avance

Gilles
Signaler un problème avec ce contenu

6 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Gilles72
Nickel François
ça marche
Daniel, le tiens devait être assez près aussi car j'ai remarqué que sur un
onglet, il y avait un espace(blanc) en trop qui ne figurait pas sur la
cellule

Un grand merci à tous les 2
Pour info, je vais poster une autre question incessemment
Si votre sagacité n'a toujours pas plus de limite, n'hésitez pas
encore merci
à+
GILLES

a écrit dans le message de news:

On 8 fév, 09:43, "Gilles72" wrote:
bonjour DANIEL,
ci dessous le code rectifié qui ne marche pas complètement
j'ai pas retenu ta proposition de Set Cal = Sheets(liste).Range("A1:A12")
car le code n'ouvre pas le fichier
avec l'ancien ça marche
atre chose:
le code ne dectecte pas les nomsd'ongletssur les cellules deLISTE
je pense que ça vient du fait qu'on ouvre le fichier, mais les
nomsd'ongletssont définis sur le fichier qui contient la macro
j'ai essayé ce code pour revenir dessus, mais sans succès
si tu vois kekchose...
Merci
gilles

Sub impri2() 'marche pas
'Application.EnableEvents = False
On Error Resume Next
Dim Cal As Range, c As Range, s As Sheets, Ligne As Long
Dim i As Integer
'Set Cal = Sheets(liste).Range("A1:A12")
Sheets(liste).Select
Set Cal = Range("A1:A12")
[A1].Select
For Each c In Cal
If c = "" Then Exit For
Workbooks.Open Filename:=c
Windows("fiche info affaire.xls").Activate
For i = 4 To 256

If Sheets(liste).Cells(c.Row, i) = "" Then Exit For
Windows("c").Activate
' Sheets(c.Offset(0, i)).PrintOut Copies:=1, Collate:=True
MsgBox "Bon bin... !...", 0, "Impression...."

Next i
ActiveWorkbook.Close False
Next c
End Sub


Salut Gilles

Ce code fonctionne :

On Error Resume Next
Dim Cal As Range, c As Range, s As Sheets, Ligne As Long
Dim i As Integer
Sheets("liste").Select
Set Cal = Range("A1:A12")
[A1].Select
For Each c In Cal
If c = "" Then Exit For
Workbooks.Open Filename:=c
For i = 4 To 256
If Workbooks("fiche info affaire.xls").Sheets("liste").Cells(c.Row, i)
= "" Then Exit For
Sheets(Workbooks("fiche info
affaire.xls").Sheets("Liste").Cells(c.Row, i).Value).PrintOut
Copies:=1, Collate:=True
MsgBox "Bon bin... !...", 0, "Impression ...."
Next i
ActiveWorkbook.Close False
Next c

Je l'ai testé

Avatar
Gilles72
Re bonjour
Juste un petit pb:
quand le dernier fichier est passé, on revient sur le fichier ou se situe
la macro, et là l'active workbook .close ferme le fichier de la macro
hyaurait-ty une bout de code à placer qui empêcherait ça?
merci
GILLES
Avatar
francois.forcet
On 8 fév, 14:04, "Gilles72" wrote:
Re bonjour
Juste un petit pb:
quand le dernier fichier  est passé, on revient sur le fichier ou se s itue
la macro, et là l'active workbook .close  ferme le fichier de la macro
hyaurait-ty une bout de code à placer qui empêcherait ça?
merci
GILLES


Rebonjours Gilles

Change la ligne :

ActiveWorkbook.Close False

par :

If ActiveWorkbook.Name <> "fiche info affaire.xls" Then
ActiveWorkbook.Close False
End If

Celà devrait convenir

Dis moi !!!

Avatar
Gilles72
Merci François
je m'orientais vers une solution dans ce genre,mais tu m'as devancé car..
ET PUIS....
y a quand même un autre petit problème:
quand il s'agit de .doc OU .pdf, il ne les prend pas
il faut que je complète le code
j'ai essayé ça mais pour l'instant sans reussite:
Workbooks.Open Filename:=c
If Not .Filename = "*.xls" Then
ActiveWindow.PrintOut Copies:=1, Collate:=True

Gilles
!!!
Avatar
francois.forcet
On 8 fév, 15:06, "Gilles72" wrote:
Merci François
je m'orientais vers une  solution dans ce genre,mais tu m'as devancé c ar..
ET PUIS....
y a quand même un autre petit problème:
quand il s'agit de .doc OU .pdf, il ne les prend pas
il faut que je complète le code
j'ai essayé ça mais pour l'instant sans reussite:
Workbooks.Open Filename:=c
If Not .Filename = "*.xls" Then
    ActiveWindow.PrintOut Copies:=1, Collate:=True

Gilles
!!!


Rebonjours à toi

Pour ouvrir un document Word et l'imprimer il faut appliquer un code
spécifique aprés avoir coché la référence : Microsof Word 11.0 Obj ect
Library
Le code :

Dim oWdApp As Object
'Lancer Word
Set oWdApp = CreateObject("Word.Application")
With oWdApp
'Afficher Word si nécessaire...
.Visible = True
'Ouvrir le document Word
Set WordDoc = oWdApp.Documents.Open("C:CheminDocument.doc")
.PrintOut
End With


inclu dans ta procédure celà donnerait
Les adresses des fichiers mis en B1:B12 :

On Error Resume Next
Dim Cal As Range, c As Range, s As Sheets, Ligne As Long
Dim i As Integer
Dim oWdApp As Object
'Lancer Word
Set oWdApp = CreateObject("Word.Application")
Sheets("liste").Select
Set Cal = Range("B1:B12")
[A1].Select
For Each c In Cal
If c = "" Then Exit For
With oWdApp
'Afficher Word si nécessaire...
.Visible = True
'Ouvrir le document Word
Set WordDoc = oWdApp.Documents.Open(c)
.PrintOut
.Documents.Close
End With
Next c

Je ne l'ai pas testé mais celà devrait fonctionner

Pour les documents Pdf je n'ai trouvé pour l'ouvrir que cette ligne de
code :

rep = Shell("""C:Program FilesAdobeAcrobat 8.0Reader
AcroRd32.exe"" ""C:CheminDocument.pdf""", vbMaximizedFocus)

C:Program FilesAdobeAcrobat 8.0 est l'adresse du programme Acrobat
reader

Il est à vérifier chez toi

Si cette ligne ouvre bien les documents Pdf je n'ai pas aprés la
solution pour l'imprimer

Peut être quelqu'un sur le forum

Espérant t'avoir aidé
Dis moi !!!!

Avatar
Gilles72
Bonjour François,
désolé ; tu vas croire que c'est du harcèlement
J'ai travaillé sur ton code et j'ai kek pb
j'ai fait un nouveau post aujourdhui
Si ta grande bonté te fait passer par lmà, n'hésite pas
merci
Gilles

a écrit dans le message de news:

On 8 fév, 15:06, "Gilles72" wrote:
Merci François
je m'orientais vers une solution dans ce genre,mais tu m'as devancé car..
ET PUIS....
y a quand même un autre petit problème:
quand il s'agit de .doc OU .pdf, il ne les prend pas
il faut que je complète le code
j'ai essayé ça mais pour l'instant sans reussite:
Workbooks.Open Filename:=c
If Not .Filename = "*.xls" Then
ActiveWindow.PrintOut Copies:=1, Collate:=True

Gilles
!!!


Rebonjours à toi

Pour ouvrir un document Word et l'imprimer il faut appliquer un code
spécifique aprés avoir coché la référence : Microsof Word 11.0 Object
Library
Le code :

Dim oWdApp As Object
'Lancer Word
Set oWdApp = CreateObject("Word.Application")
With oWdApp
'Afficher Word si nécessaire...
.Visible = True
'Ouvrir le document Word
Set WordDoc = oWdApp.Documents.Open("C:CheminDocument.doc")
.PrintOut
End With


inclu dans ta procédure celà donnerait
Les adresses des fichiers mis en B1:B12 :

On Error Resume Next
Dim Cal As Range, c As Range, s As Sheets, Ligne As Long
Dim i As Integer
Dim oWdApp As Object
'Lancer Word
Set oWdApp = CreateObject("Word.Application")
Sheets("liste").Select
Set Cal = Range("B1:B12")
[A1].Select
For Each c In Cal
If c = "" Then Exit For
With oWdApp
'Afficher Word si nécessaire...
.Visible = True
'Ouvrir le document Word
Set WordDoc = oWdApp.Documents.Open(c)
.PrintOut
.Documents.Close
End With
Next c

Je ne l'ai pas testé mais celà devrait fonctionner

Pour les documents Pdf je n'ai trouvé pour l'ouvrir que cette ligne de
code :

rep = Shell("""C:Program FilesAdobeAcrobat 8.0Reader
AcroRd32.exe"" ""C:CheminDocument.pdf""", vbMaximizedFocus)

C:Program FilesAdobeAcrobat 8.0 est l'adresse du programme Acrobat
reader

Il est à vérifier chez toi

Si cette ligne ouvre bien les documents Pdf je n'ai pas aprés la
solution pour l'imprimer

Peut être quelqu'un sur le forum

Espérant t'avoir aidé
Dis moi !!!!

1 2