Aide pour vb6 et wordRésolu

Question

Bonjour &#224; tous!
Voila, j'ai un souci!J'ai &#233;cris un script vb 6 pour pouvoir passer un tableau word sur une feuille excel et la paginer automatiquement.
Mais voila, ce code fonctionne tr&#233;s bien lorsque aucun autre document word n'est ouvert! Dans le cas contraire , c'est  le premier document word qui a &#233;t&#233; ouvert  qui sera copi&#233; dans ma feuille excel! Je pense qu'il s'agit d'une histoire activedocument mais je ne vois pas comment faire ! Merci d'avance 
Voici le code :
 
Sub Main()
'Penser &#224; lancer les r&#233;f&#233;rences de word et excel
Dim monwd As Object
Dim mondoc As Object
Dim Xl As excel.Applicationdim cheminacces As String
Dim cheminacces_final As String


cheminacces = "[file://windows/gestion/ \windows\gestion\]" & Dir("[file://%20windows/gestion/*.doc \ windows\gestion\*.doc]")
cheminacces_final = Replace(cheminacces, ".doc", ".xls")


'Ouvrir Word
Set monwd = CreateObject("Word.Application")
Set mondoc = monwd.Documents.Open("" & cheminacces & "")
monwd.Visible = True
'copier le document
ActiveDocument.Select
Selection.Copy
'ouvrir excel
Set Xl = New excel.Application
Xl.Workbooks.Add
Xl.Visible = True
Set Xl = Nothing


'copie dans la feuille excel
ActiveSheet.Paste
'vider le presse papier
Clipboard.Clear

'insertion des lignes
ActiveSheet.Rows(1).Insert Shift:=xlDown
ActiveSheet.Rows(2).Insert Shift:=xlDown


'mise en forme
ActiveSheet.Select
Selection.Font.Size = 10


With Range(Cells(1, 1), Cells(1, 16))
    .MergeCells = True
    .Interior.ColorIndex = 1
    .Font.Bold = True
    .Font.Size = 14
    .Font.ColorIndex = 2
    .Value = Replace(ActiveDocument.Name, ".doc", "")
End With


Range(Cells(2, 1), Cells(2, 16)).MergeCells = True


With Range(Cells(3, 1), Cells(3, 16))
    .Interior.ColorIndex = 36
    .Font.Size = 12
End With


'sauvegarde du .xls
ActiveWorkbook.SaveAs FileName:="" & cheminacces_final & "", FileFormat:= _
       xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
       , CreateBackup:=False
       
'fermeture du doc word
mondoc.Close


'fermeture de word
monwd.Quit
Set monwd = Nothing


'suppression du fichier .doc
Kill "" & cheminacces & ""


End Sub

mrdep1978 · Accepted Answer

Essaie &#231;a. 
Clipboard.clear ne fonctionne pas chez moi (Office 2003 ??)

Sub Main()
'Penser &#224; lancer les r&#233;f&#233;rences de word et excel
Dim monwd As Object
Dim mondoc As Object
Dim cheminacces As String
Dim cheminacces_final As String
Dim ls_MonDoc As String
Dim l_Workbook As Excel.Workbook
Dim l_Sheet As Excel.Worksheet
Dim l_App As Excel.Application
cheminacces = "[file://windows/gestion/ \windows\gestion\]" & Dir("\ windows\gestion\*.doc")
cheminacces_final = Replace(cheminacces, ".doc", ".xls")
'Ouvrir Word
Set monwd = CreateObject("Word.Application")
'Ouvre en lecture seule
Set mondoc = monwd.Documents.Open(cheminacces, , True)
ls_MonDoc = mondoc.Name
'monwd.Visible = True
'copier le document
mondoc.Range.Copy


Set l_App = New Excel.Application
Set l_Workbook = Workbooks.Add
Set l_Sheet = l_Workbook.Worksheets(1)


'copie dans la feuille excel
l_Sheet.Paste
'vider le presse papier
Clipboard.Clear


'fermeture du doc word
mondoc.Close
'fermeture de word
monwd.Quit
Set monwd = Nothing
'suppression du fichier .doc
Kill cheminacces


'insertion des lignes
l_Sheet.Rows(1).Insert Shift:=xlDown
l_Sheet.Rows(2).Insert Shift:=xlDown


'mise en forme
l_Sheet.UsedRange.Font.Size = 10


With l_Sheet.Range(Cells(1, 1), Cells(1, 16))
    .MergeCells = True
    .Interior.ColorIndex = 1
    .Font.Bold = True
    .Font.Size = 14
    .Font.ColorIndex = 2
    .Value = Replace(ls_MonDoc, ".doc", "")
End With


l_Sheet.Range(Cells(2, 1), Cells(2, 16)).MergeCells = True


With l_Sheet.Range(Cells(3, 1), Cells(3, 16))
    .Interior.ColorIndex = 36
    .Font.Size = 12
End With
'sauvegarde du .xls
l_Workbook.SaveAs Filename:=cheminacces_final, FileFormat:= _
       xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
       , CreateBackup:=False
l_Workbook.Close
l_App.Quit
Set l_Sheet = Nothing
Set l_Workbook = Nothing
Set l_App = Nothing
End Sub

got31 · Answer

Ton code r&#233;pond tout a fait a ce que je voulais !merci beaucoup!
Maintenant je peux lancer mon script et m&#234;me avec d'autre .doc ouvert en simultan&#233;, il ne s'occupe que de mon.doc.
Merci encore.

Aide pour vb6 et word

2 réponses

Discussions similaires