VBA - transferer des valeurs de Word vers Excel

VBA - transferer des valeurs de Word vers Excel - VB/VBA/VBS - Programmation

Marsh Posté le 27-06-2007 à 20:55:34    

Bonsoir à tous,  :hello:  
A partir d'un document Word, je souhaites récupérer certaines valeurs d'un tableau pour les transférer automatiquement dans un fichier Excel.
 
Avec de l'aide sur des forums, j'ai ce code :

Citation :

Sub Test()
Dim objTable As Table
Dim xlApp As Excel.Application
Dim xlSheet As Excel.Worksheet
Dim xlBook As Excel.Workbook
Dim a As String
Dim b As String
Dim c As String
 
' Partie 1 : Récupérer les valeurs du tableau Word sans les 2 derniers caractères bizarres
Set objTable = ActiveDocument.Tables(1)
 
a1 = Len(Mid(objTable.Cell(1, 1), 7, 25)) - 2
a2 = Mid(objTable.Cell(1, 1), 7, a1)
 
b1 = Len(Mid(objTable.Cell(1, 2), 10, 25)) - 2
b2 = Mid(objTable.Cell(1, 2), 10, b1)
 
c1 = Len(Mid(objTable.Cell(1, 3), 7, 25)) - 2
c2 = Mid(objTable.Cell(1, 3), 7, c1)
 
'Partie 2 : Création excel
    Set xlApp = CreateObject("Excel.Application" )
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets.Add
 
'Partie 3 : coller les valeurs dans les cellules de Excel
    xlSheet.Cells(1, 1) = a2
    xlSheet.Cells(1, 2) = b2
    xlSheet.Cells(1, 3) = c2
     
xlApp.Visible = True
End Sub


 
Partie 1 ; pas de problème, je récupère bien mes valeurs  :)  
 
J'ai des problèmes pour modifier la partie 2 et 3  :pt1cable:  
Partie 2 ; ce code ouvre à chaque fois un nouveau fichier Excel.
Je souhaiterais qu'il active simplement mon fichier Excel déjà ouvert "Monfichier.xls"
 
Partie 3 ; les valeurs sont copiées dans les 3 premières cellules de Excel.
Je souhaiterais avoir la possibilité de choisir l'emplacement où seront copiés les valeurs, via un message du type "sélectionner la cellule de destination"
 
Pourriez vous m'aider à modifier ce code pour ces deux problèmes  :hello:


Message édité par didieraucun le 28-06-2007 à 20:00:40
Reply

Marsh Posté le 27-06-2007 à 20:55:34   

Reply

Marsh Posté le 28-06-2007 à 00:02:20    

il suffit a mon avis de virer le createobject,
tu fais un
set xlbook = workbook.openfile("tonfichier)
et ca devrait aller.
 
bon comme il est minuit, le code est peut être approximatif, mais il a le mérite d'apparaitre  :sleep:

Reply

Marsh Posté le 28-06-2007 à 20:06:39    

:(

 


Message édité par didieraucun le 05-07-2007 à 23:45:30
Reply

Marsh Posté le 29-06-2007 à 16:19:50    

Essaye plutôt :
 
'Partie 2 : Création excel
    Set xlApp = CreateObject("Excel.Application" )
    xlApp.Workbooks.Open "c:\Mon_Dossier\Mon_Fichier.xls"
 
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets.Add

Reply

Marsh Posté le 29-06-2007 à 19:57:03    

le fichier "Mon_Fichier.xls" s'ouvre bien mais également un autre fichier excel.  :heink:  
Et les valeurs sont collées dans le mauvais fichier.  :non:  
 
Modifié comme cela, ça marche :  :)  

Citation :

Set xlApp = CreateObject("Excel.Application" )
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open("D:\Mes Documents\Excel\Toto.xls" )
Set xlSheet = xlBook.Sheets("Feuil1" )


 
Le problème est que lorsque j'exécute la macro alors que mon fichier Toto.xls est déjà ouvert, un nouveau fichier Toto.xls s'ouvre en lecture seule  :??:  
 
J'ai trouvé un code, sur le net, qui apparemment contrôle l'ouverture d'un fichier :

Citation :

Sub WB_Open()
dim MyBook As Workbook
dim Myname As String, MyPath As String
dim Win As Window
dim IsOpen As Boolean
 
    Myname = "Mon_Fichier.xls"
    MyPath = "c:\Mon_Dossier\" 'or any other path
 
    for each Win In Windows
        if Win.Caption = Myname then
            Win.Activate
            IsOpen = true
            Exit for
        end if
    next Win
    if Not IsOpen then workbooks.Open (MyPath & Myname)
    set MyBook = activeworkbook
end Sub


Mais il ouvre le fichier en mémoire est n'est pas visible  :pt1cable:

Reply

Marsh Posté le 30-06-2007 à 12:30:58    

un .visible = true devrait faire l'affaire...

Reply

Marsh Posté le 30-06-2007 à 19:33:27    

et je mets ça où ?

Reply

Marsh Posté le 30-06-2007 à 20:24:39    

je pense mybook.visible = true

Reply

Marsh Posté le 30-06-2007 à 23:23:41    

J'ai touvé un autre code

Citation :

Sub Test2()
Dim Chemin$, Wbk As Workbook
 
Chemin = "D:\Mes Documents\Excel\ToTo.xls"
On Error Resume Next
 
Workbooks(Dir$(Chemin)).Activate
If Err <> 0 Then
Err.Clear
Workbooks.Open Chemin
End If
Set Wbk = Workbooks(Dir$(Chemin))
MsgBox Wbk.Name
'etc.
End Sub


 
Il fonctionne à merveille intégré dans Excel mais je n'arrive pas à le faire fonctionner dans Word  :heink:  
Il y a certainement plein de variable à rajouter comme CreateObject("Excel.Application" ) mais je ne suis pas assez bon en VBA  :ange:

Reply

Marsh Posté le 30-06-2007 à 23:27:10    

jpcheck a écrit :

je pense mybook.visible = true


non marche pas  
http://img401.imageshack.us/img401/8705/clipboard1xw0.jpg
Shot at 2007-06-30

Reply

Marsh Posté le 30-06-2007 à 23:27:10   

Reply

Marsh Posté le 01-07-2007 à 09:05:44    

si tu travailles sous word, tu as pensé a ajouté la référence excel hein ? ;)

Reply

Marsh Posté le 01-07-2007 à 12:44:24    

Voici les références :
http://img297.imageshack.us/img297/189/clipboard1rj5.jpg
Il en manque une ?

Reply

Marsh Posté le 01-07-2007 à 12:55:45    

C'est plutôt :
 
MyBook.SetVisible = True  
 
 ;)

Reply

Marsh Posté le 01-07-2007 à 20:25:42    

:non: marche pas non plus.
Peut être parce que le code tourne sous Word pour faire fonctionner Excel ?
http://img529.imageshack.us/img529/5064/clipboard1pz7.jpg
Shot at 2007-07-01
 
Et en modifiant ce code ?

Citation :

J'ai touvé un autre code
Citation :
 
Sub Test2()
Dim Chemin$, Wbk As Workbook
 
Chemin = "D:\Mes Documents\Excel\ToTo.xls"
On Error Resume Next
 
Workbooks(Dir$(Chemin)).Activate
If Err <> 0 Then
Err.Clear
Workbooks.Open Chemin
End If
Set Wbk = Workbooks(Dir$(Chemin))
MsgBox Wbk.Name
'etc.
End Sub
 
 
 
Il fonctionne à merveille intégré dans Excel mais je n'arrive pas à le faire fonctionner dans Word  :heink:  
Il y a certainement plein de variable à rajouter comme CreateObject("Excel.Application" ) mais je ne suis pas assez bon en VBA  :ange:

Reply

Marsh Posté le 02-07-2007 à 10:01:11    

Ton problème est bien que ton code est lancé sous Word et qu'il s'agit de VBA orienté Excel.
Il te faut créer une instance objet pour Excel (Set objExcel = New Excel.application) et utiliser cet objet avec toutes tes fonctions Excel.
Set myBook = objExcel.Workbooks.Open (Chemin)
mybook.Visible = True


Message édité par tegu le 02-07-2007 à 10:01:24
Reply

Marsh Posté le 02-07-2007 à 20:25:48    

J'ai essayé, mais j'ai des erreurs ....
Peux tu me modifier le code ?

Reply

Marsh Posté le 05-07-2007 à 23:43:22    

j'ai modifié le code comme suit :

Citation :

Sub Test()
Dim a As String
Dim objExcel, objClasseur
Set objExcel = CreateObject("Excel.Application" )
 
' Controle si le fichier Toto.xls est ouvert et l'ouvre si necessaire
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
 
Dim strExcelFile, objFso, objFile
strExcelFile = "D:\Mes Documents\Excel\Toto.xls"
Set objFso = CreateObject("Scripting.FileSystemObject" )
 
On Error Resume Next
Set objFile = objFso.OpenTextFile(strExcelFile, ForAppending, TristateFalse)
 
If Err.Number <> 0 Then
MsgBox "Le fichier est déjà ouvert" & vbCrLf & Err.Number & vbCrLf _
           & Err.Source & vbCrLf & Err.Description: Err.Clear
          ' Que mettre ici pour aciver le fichier "Toto.xls" déjà ouvert ?
           
 Else
   MsgBox "Le fichier n'est pas ouvert"
      objFile.Close
      Set objClasseur = objExcel.Workbooks.Open(strExcelFile)
   'objExcel.DisplayAlerts = False
   objExcel.Application.Visible = True 'False
   'MsgBox "fichier " & strExcelFile & " ouvert"
   'objExcel.Quit
   
End If
 
' Partie 2 : Récupérer les valeurs du tableau Word sans les 2 derniers caractères bizarres
Set objTable = ActiveDocument.Tables(1)
a1 = Len(Mid(objTable.Cell(1, 1), 7, 25)) - 2
a2 = Mid(objTable.Cell(1, 1), 7, a1)
 
' partie 3 : Lance la macro "Macro1" de Excel
objExcel.Run ("Macro1" ) 'lance la macro de Excel
'objExcel.Cells(1, 1) = a2
' que mettre pour transferer la variable a2 dans la macro "Macro1" de Excel ?
 
'MsgBox a1 & " - " & a2
 
Set objExcel = Nothing
Set objClasseur = Nothing
Set objFile = Nothing
Set objFso = Nothing
End Sub


 
Mais je n'arrive pas à trouver la solution pour :
1 - Activer le fichier "Toto.xls" si il est déjà ouvert ? Le fichier est ouvert en arrière plan et la suite du programme ne s'exécute pas !
2 - Pour transférer la variable a2 de la macro Word "Test" dans la macro "Macro1" de Excel ?
 
Pouvez vous m'aider  :hello:

Reply

Marsh Posté le 07-07-2007 à 10:51:04    

Tout le monde est déjà partit en vacance  :sol:

Reply

Marsh Posté le 09-07-2007 à 11:17:56    

« Set objClasseur = Workbooks("toto.xls" ) » devrait convenir à ton besoin s'il est déjà ouvert avec Excel.

Reply

Marsh Posté le 09-07-2007 à 23:01:29    

.... sauf tegu qui est encore là ... merci
 
J'ai le message d'erreur "Permission refusée"
Je crois bien que ce problème est insoluble !
J'ai parcouru le net et je n'ai rien trouvé sur le sujet.
 
Tout les exemples de code reprennent la solution :
Set objExcel = CreateObject("Excel.Application" )  
Set objClasseur = objExcel.Workbooks.Open(fichier)
      objExcel.Application.Visible = True  
 

Reply

Marsh Posté le 10-07-2007 à 03:54:40    

Dans ton 1er listing de code
Partie 2 et 3 réunies
A adapter  


    ......
    If WB_Open("MonFichier.xls" ) Then
        Workbooks("MonFichier.xls" ).Activate
        Workbooks("MonFichier.xls" ).Sheets("Feuil1" ).Cells(1, 1) = a2
        Workbooks("MonFichier.xls" ).Sheets("Feuil1" ).Cells(1, 2) = b2
        Workbooks("MonFichier.xls" ).Sheets("Feuil1" ).Cells(1, 3) = c2
    Else
        Set xlApp = New Excel.Application
        xlApp.Workbooks.Open ("C:\Transfert\MonFichier.xls" )
         
        xlApp.Workbooks("MonFichier.xls" ).Sheets("Feuil1" ).Cells(1, 1) = a2
        xlApp.Workbooks("MonFichier.xls" ).Sheets("Feuil1" ).Cells(1, 2) = b2
        xlApp.Workbooks("MonFichier.xls" ).Sheets("Feuil1" ).Cells(1, 3) = c2
        xlApp.Visible = True
     
        Set xlApp = Nothing
    End If
End Sub
 
Private Function WB_Open(ByVal NomFichier As String) As Boolean
Dim Wb As Excel.Workbook
    WB_Open = False
    For Each Wb In Excel.Workbooks
        If Wb.Name = NomFichier Then
            WB_Open = True
            Exit For
        End If
    Next Wb
End Function



Message édité par kiki29 le 10-07-2007 à 04:59:46
Reply

Marsh Posté le 10-07-2007 à 22:20:17    

Citation :

....
xlApp.Workbooks.Open ("C:\Transfert\MonFichier.xls" )
         
        xlApp.Workbooks("MonFichier.xls" ).Sheets("Feuil1" ).Cells(1, 1) = a2  
....


 
"C:\Transfert\MonFichier.xls" et "MonFichier.xls" c'est normal des noms de fichier différents ?
 

Reply

Marsh Posté le 11-07-2007 à 08:57:30    

ne confonds pas le fichier et le classeur ;)

Reply

Marsh Posté le 15-07-2007 à 11:46:21    

jpcheck a écrit :

ne confonds pas le fichier et le classeur ;)


Exact. Merci  :)  

Reply

Marsh Posté le    

Reply

Sujets relatifs:

Leave a Replay

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