pb script VBA sous Word pour export feuilles - laisse 1 page

pb script VBA sous Word pour export feuilles - laisse 1 page - VB/VBA/VBS - Programmation

Marsh Posté le 21-05-2019 à 11:53:21    

Bonjour,
 
J'ai effectué un publipostage à partir d'une base de données excel sur Word (via l'aide de certaines personnes ici, encore grand merci) (https://forum.hardware.fr/hfr/WindowsSoftware/Securite/recupere-fichier-document-sujet_351116_1.htm#t3343552),  
Puis, j'ai utilisé une macro VBA pour exporter toutes les feuilles séparément,  
par contre, ca laisse toujours une page en plus. Que faire? Une idee?   :hello:  :hello:  :ouch:  :ouch:  :pt1cable:  
 
voici le code que je mets :
Sub SplitIntoPages()  
Dim docMultiple As Document  
Dim docSingle As Document  
Dim rngPage As Range  
Dim iCurrentPage As Integer  
Dim iPageCount As Integer  
Dim strNewFileName As String  
Application.ScreenUpdating = False 'Makes the code run faster and reduces screen flicker a bit.  
Set docMultiple = ActiveDocument 'Work on the active document (the one currently containing the Selection)  
Set rngPage = docMultiple.Range 'instantiate the range object  
iCurrentPage = 1  
'get the document's page count  
iPageCount = docMultiple.Content.ComputeStatistics(wdStatisticPages)  
Do Until iCurrentPage > iPageCount  
If iCurrentPage = iPageCount Then  
rngPage.End = ActiveDocument.Range.End 'last page (there won't be a next page)  
Else  
'Find the beginning of the next page  
'Must use the Selection object. The Range.Goto method will not work on a page  
Selection.GoTo wdGoToPage, wdGoToAbsolute, iCurrentPage + 1  
'Set the end of the range to the point between the pages  
rngPage.End = Selection.Start  
End If  
rngPage.Copy 'copy the page into the Windows clipboard  
Set docSingle = Documents.Add 'create a new document  
docSingle.Range.Paste 'paste the clipboard contents to the new document  
'remove any manual page break to prevent a second blank  
docSingle.Range.Find.Execute Findtext:="^m", ReplaceWith:=""  
'build a new sequentially-numbered file name based on the original multi-paged file name and path  
strNewFileName = Replace(docMultiple.FullName, ".doc", "_" & Right$("000" & iCurrentPage, 4) & ".doc" )  
docSingle.SaveAs strNewFileName 'save the new single-paged document  
iCurrentPage = iCurrentPage + 1 'move to the next page  
docSingle.Close 'close the new document  
rngPage.Collapse wdCollapseEnd 'go to the next page  
Loop 'go to the top of the do loop  
Application.ScreenUpdating = True 'restore the screen updating  
'Destroy the objects.  
Set docMultiple = Nothing  
Set docSingle = Nothing  
Set rngPage = Nothing  
End Sub  
 
 
merci par avance de votre aide.
 
Nicolas

Reply

Marsh Posté le 21-05-2019 à 11:53:21   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed