faire apparaitre dans une cellul ou msgbox le n° de la page en cour d'impression

bonjour
je souhaite faire apparaitre dans une cellule ou msgbox le n° de la page en cour d'impression
je vous remercie par avance

bonjour

c´est três difficile de piloter l´impression, peut-ètre pourras-tu trouver des exemples dans les archives de google

http://groups.google.com
puis tape group:*.fr.excel et tes mots de recherche

tu pourrais peut-etre chercher un moyen de contròler si l´impression est faite ou pas, et imprimer page par page pour connaìtre la page actuellement en cours ou en attente d´impression

bye
steph

bonsoir Nychko , bonsoir Stephane

la macro jointe permet d'imprimer la Feuil1 du classeur , et d'afficher dans la barre de statut le nombre de pages qui ont été imprimées et le nombre total de pages à imprimer ... pour cet onglet
un rafraichissement toutes les 2 secondes permet de mettre à jour la barre de statut

remarque importante:
sur mon poste , pour que objItem.PagesPrinted et objItem.TotalPages renvoient des valeurs cohérentes j'ai du installer les drivers spécifiques fournis avec l'imprimante en lieu et place du driver de WindowsXP par defaut !

cette procedure ne prend pas en compte l'impression de plusieurs onglets simultanés
il ne faut pas oublier d'activer la référence Microsoft WMI Scripting Library
testé avec Excel2002 et WinXP



Option Explicit
Dim NbImp As Byte, NbTot As Byte

Sub Imprimer()
Feuil1.PrintOut 'lance l'impression de la Feuil1
Application.DisplayStatusBar = True
Application.StatusBar = "Lancement Impression..."

Suivi_Impression
End Sub

Sub Suivi_Impression()
'source http://microsoft.supinfo.com/scripts/default.asp?Page_No=1&Page_Tri=
'adapté par michelxld pour le forum http://www.excel-downloads.com
'http://www.excel-downloads.com/html/French/forum/read.php?f=1&i=126077&t=125521
'le 21.11.2004 , testé avec WinXP et Excel2002
'necessite d'activer les references Microsoft WMI Scripting Library
'Dim objWMIService As Object, colItems As Object, objItem As Object

Dim nomPC As String
Dim objWMIService As WbemScripting.SWbemServices
Dim colItems As WbemScripting.SWbemObjectSet
Dim objItem As WbemScripting.SWbemObject
Dim objPrintJobSet As Object

nomPC = "."

Set objWMIService = GetObject("winmgmts:\\" & nomPC & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PrintJob", , 48)

'remarque importante:
'sur mon poste , pour que objItem.PagesPrinted et objItem.TotalPages renvoient des valeurs
'cohérentes j'ai du installer les drivers spécifiques fournis avec l'imprimante
'en lieu et place du driver de WindowsXP par defaut !
'les informations s'affichent dans la barre de statut
For Each objItem In colItems
NbTot = objItem.TotalPages
NbImp = objItem.PagesPrinted
Application.StatusBar = "Nombre de pages imprimées : " & NbImp & "/" & NbImp + NbTot

Next

'************************************
Set objPrintJobSet = objWMIService.InstancesOf("Win32_PrintJob")
If objPrintJobSet.Count = 0 Then
Application.StatusBar = "Impression terminée " & NbImp + NbTot & "/" & NbImp + NbTot
Finir
Exit Sub
End If
'***************************************
Temporisation

End Sub

Sub Temporisation()
Application.OnTime Now + TimeValue("00:00:02"), "Suivi_Impression"
End Sub

Sub Finir()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "Suivi_Impression", , Schedule:=False
End Sub



bonne soirée
MichelXld

Salut Michel, Nychko, le forum


super !
j´essayerais de la faire tourner à mon retour en France sur xl 2000.

si j´ai bien compris la macro, on suit toutes les impressions en cours (et déjà en cours)


bye
stephane

bonjour Stephane

merci pour ton message

oui c'est cela : si une édition est en cours , la macro "Suivi_Impression" permet de récuperer le nombre total de pages à imprimer , ainsi que le nombre de pages déjà imprimées .

cette procedure ne fonctionne pas s'il y a plusieurs documents dans la file d'attente d'impression. ce qui est normal puisqu'elle est basée sur une boucle for each , qui ne renvoie que les dernieres données de l'imprimante. Si j'ai un peu de temps j'essayerai de travailer sur ce probleme .


bonne soirée
MichelXld

rebonsoir

Cette nouvelle version permet le suivi d'impression pour plusieurs classeurs consécutifs . Les impressions multi-onglets et les copies multiples sont aussi gérés.
Les informations sur le document en cours d'édition s'affichent dans la barre de statut :
le nombre de pages déja imprimées
le nombre total de pages à imprimer
le nom du document imprimé



Option Explicit
Public NbTotCle As Byte, NbImpCle As Byte, NbImp As Byte
Public FicCle As String

Sub Suivi_Impression_V02()
'michelxld pour le forum http://www.excel-downloads.com
'http://www.excel-downloads.com/html/French/forum/read.php?f=1&i=126077&t=125521
'le 22.11.2004 , testé avec WinXP et Excel2002
'necessite d'activer la reference Microsoft WMI Scripting Library
Dim nomPC As String, Fichier As String
Dim objWMIService As WbemScripting.SWbemServices
Dim colItems As WbemScripting.SWbemObjectSet
Dim objItem As WbemScripting.SWbemObject
Dim objPrintJobSet As Object
Dim NbTot As Byte, i As Byte
Dim Tableau()

nomPC = "."

Set objWMIService = GetObject("winmgmts:\\" & nomPC & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PrintJob", , 48)
Set objPrintJobSet = objWMIService.InstancesOf("Win32_PrintJob")

ReDim Tableau(objPrintJobSet.Count, 3)
'remarque importante:
'sur mon poste , pour que objItem.PagesPrinted et objItem.TotalPages renvoient des valeurs
'cohérentes j'ai du installer les drivers spécifiques fournis avec l'imprimante
'et les utiliser à la place du driver de WindowsXP par defaut !
For Each objItem In colItems
Tableau(i, 0) = objItem.TotalPages 'nb de pages restant à imprimer
Tableau(i, 1) = objItem.PagesPrinted 'nb de pages imprimées
Tableau(i, 2) = objItem.document 'nom du document en cours d'impression
i = i + 1
Next

Fichier = Tableau(0, 2)
'************************************************* ************
'permet de compter les pages pour l'edition de plusieurs onglets d'un document
'ou pour l'impression de plusieurs copies
For i = 0 To UBound(Tableau)
If Tableau(i, 2) = Fichier Then
NbTot = NbTot + Tableau(i, 0)
End If
Next i

If Fichier <> FicCle Then
FicCle = Fichier
NbTotCle = NbTot
NbImp = 0
NbImpCle = 0
Else
If NbImp <> Tableau(0, 1) Then NbImpCle = NbImpCle + 1

NbImp = Tableau(0, 1)
End If
'************************************************* ************

Application.StatusBar = "Nombre de pages imprimées : " & NbImpCle & "/" & NbTotCle & " " & Fichier
'***********************************************
If objPrintJobSet.Count = 0 Then
Application.StatusBar = "Impression terminée"
Finir
Exit Sub
End If
'************************************************

Temporisation

End Sub

Sub Temporisation()
Application.OnTime Now + TimeValue("00:00:02"), "Suivi_Impression_V02"
End Sub

Sub Finir()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "Suivi_Impression_V02", , Schedule:=False
End Sub


tous vos tests et remarques sont les bienvenus

bonne soirée
MichelXld