Transfert data vers excel

**master1551** · 08/01/2013, 15h08

Bonjour,
Je souhaite envoyer vers un fichier excel des infos reçues par mail.

Je dois vérifier si le fichier excel n'est pas déjà ouvert, et l'ouvrir si besoin ( cela à l'air de fonctionner )

J'ai un soucis car je n'arrive pas remplir mes cellules dans mon fichier excel de réception des infos
Je galère pour me faire comprendre alors je mets un bout de macro en espérant que cela vous aide.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Private Sub CommandButton2_Click()
 
Dim myItems As Outlook.Items
Dim myItem As Object
Dim bus As String
Dim fichier As String
Dim fichier1 As String
Dim a As String
Dim appxl As Excel.Application    
Dim wb As Excel.Workbook    
 
 
fichier1 = "commande.xlsx"
Call Fichier1XlsOuvert(fichier1)
 
Set wb = appxl.Workbooks(fichier1)
 
 
wb.Sheets("feuil1").Range("A65536").End(xlUp).Offset(1, 0) = UserForm1.Label4.Caption
 
End sub
 
 
Function Fichier1XlsOuvert(NomFichier1Xls As String) As Boolean
 
On Error GoTo erreur
Dim xla As Object
Dim wb As Excel.Workbook    'Classeur Excel
Dim fichier As String
 
fichier = "C:\commande.xlsx"
Fichier1XlsOuvert = False
 
Set xla = GetObject(, "Excel.application")
 
 If xla.Workbooks(NomFichier1Xls).Name = NomFichier1Xls Then Fichier1XlsOuvert = True
 
 Exit Function
 
erreur:
 
 Set xla = CreateObject("Excel.Application")
  xla.Visible = True
 Set wb = xla.Workbooks.Open(fichier)
End Function

**Oliv-** · 09/01/2013, 10h06

Salut,

Si tu as une fonction, il faudrait qu'elle te renvoi un objet Excel.application ou Workbooks.

Essaye comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub CommandButton2_Click()
 
Dim myItems As Outlook.Items
Dim myItem As Object
Dim bus As String
Dim fichier As String
Dim fichier1 As String
Dim a As String
Dim appxl As Excel.Application    
Dim wb As Excel.Workbook    
 
 
fichier1 = "commande.xlsx"
 
Set wb = Fichier1XlsOuvert(fichier1)
 
 
wb.Sheets("feuil1").Range("A65536").End(xlUp).Offset(1, 0).value = UserForm1.Label4.Caption
 
End sub
 
 
Function Fichier1XlsOuvert(NomFichier1Xls As String) As object
 
On Error GoTo erreur
Dim xla As Object
Dim wb As Excel.Workbook    'Classeur Excel
Dim fichier As String
 
Fichier1XlsOuvert = False
 
Set xla = GetObject(, "Excel.application")

If xla.Workbooks(NomFichier1Xls).Name = NomFichier1Xls Then NomFichier1Xls = xla.Workbooks(NomFichier1Xls)
 
 Exit Function
 
erreur:
 
Set xla = CreateObject("Excel.Application")
xla.Visible = True
Set NomFichier1Xls= xla.Workbooks.Open(fichier)
End Function

sinon tu peux faire toutes tes opération excel dans ta focntion (ou Sub)

**master1551** · 09/01/2013, 13h33

Salut Oliv-

Avec ta solution, j'ai une erreur "objet requis" sur la ligne 42

Set NomFichier1Xls= xla.Workbooks.Open(fichier)

**Oliv-** · 09/01/2013, 15h16

cette fois je l'ai testé.
attention il te faut le chemin complet du fichier ou alors il faut que le dirpath soit positionnée sur le dossier en question.

GetObject(, "Excel.application") a aussi ses limites si tu as 2 instances de Excel ouvertes !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Private Sub CommandButton2_Click()
 
'Dim myItems As Outlook.Items
'Dim myItem As Object
'Dim bus As String
Dim fichier As String
Dim fichier1 As String
Dim a As String
Dim appxl As Excel.Application
Dim wb As Excel.Workbook
 
 
fichier1 = "C:\temp\Liste (v001).xls"
 
Set wb = Fichier1XlsOuvert(fichier1)
 
 
wb.Sheets("feuil1").Range("A65536").End(xlUp).Offset(1, 0).Value = "toto" 'UserForm1.Label4.Caption
 
End Sub
 
 
Function Fichier1XlsOuvert(NomFichier1Xls As String) As Object
 
On Error GoTo erreur
Dim xla As Object
Dim wb As Excel.Workbook    'Classeur Excel
Dim fichier As String
 
Set xla = GetObject(, "Excel.application")
NomFichier = StrReverse(Split(StrReverse(NomFichier1Xls), "\")(0))
 
If xla.Workbooks(NomFichier).Name = NomFichier Then Fichier1XlsOuvert = xla.Workbooks(NomFichier)
 
Exit Function
 
erreur:
 
Set xla = Excel.Application
xla.Visible = True
Set Fichier1XlsOuvert = xla.Workbooks.Open(NomFichier1Xls)
End Function

**master1551** · 10/01/2013, 09h57

Merci pour ton aide....
J'ai trouvé une solution un peu différente qui marche......
je poste mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Private Sub CommandButton2_Click()
 
Dim myItems As Outlook.Items
Dim myItem As Object
Dim wb As Excel.Workbook
Dim appxl As Excel.Application
Dim xla As Object
 
 
Dim a As String
Dim b As String
Dim c As String
 
Dim bus As String
Dim fichier As String
Dim fichier1 As String
 
 
Dim i As Long
Dim j As Long
 
b = Now
b = Format(b, "YYYY")
 
 
fichier1 = "commande.xlsx"
fichier = "C:\commande.xlsx"
 
Set appxl = Excel.Application '
j = appxl.Workbooks.Count ' compte nmbre fichier excel ouverts
If j = 0 Then GoTo 2 ' si 0 alors ouvre le fichier commande goto 2:
 For i = 1 To j
 c = appxl.Workbooks(i).Name
 
 If c = fichier1 Then
 GoTo 1
 End If
 Next i
 
2:
Set wb = appxl.Workbooks.Open(fichier)
appxl.Visible = True
 
1:
 
Set wb = appxl.ActiveWorkbook
 
 
wb.Sheets(b).Range("A65536").End(xlUp).Offset(1, 0) = UserForm1.Label4.Caption
wb.Sheets(b).Range("A65536").End(xlUp).Offset(0, 9) = UserForm1.Label2.Caption
 
If Not InStr(1, UserForm1.Label6.Caption, "le bus N°", 1) = 0 Then
        bus = Mid(UserForm1.Label6.Caption, 11, Len(UserForm1.Label6.Caption))
        wb.Sheets(b).Range("A65536").End(xlUp).Offset(0, 11) = bus
        wb.Sheets(b).Range("A65536").End(xlUp).Offset(0, 8) = "Bus"
End If
 
 If Not InStr(1, UserForm1.Label6.Caption, "N° d'Ordre", 1) = 0 Then
 
    a = UserForm1.MultiPage1.Pages(0).Label8.Caption
        wb.Sheets(b).Range("A65536").End(xlUp).Offset(0, 11) = a
 
    a = UserForm1.MultiPage1.Pages(0).Label25.Caption
        wb.Sheets(b).Range("A65536").End(xlUp).Offset(0, 8) = a
    a = UserForm1.MultiPage1.Pages(0).Label11.Caption
        wb.Sheets(b).Range("A65536").End(xlUp).Offset(0, 14) = a
 
End If
 
MsgBox "Infos ajoutées dans tableau"
Unload UserForm1

**Oliv-** · 10/01/2013, 10h23

C'est effectivement une autre façon de faire. mais ton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set appxl = Excel.Application

va systématiquement t'ouvrir un NOUVEAU excel.

Par contre ma remarque sur le nombre de sessions excel reste valable. !

Tu pourrais faire le contraire, ouvrir toujours le fichier excel avec appxl.Workbooks.Open(fichier) et si le fichier est en lecture seule c'est qu'il est déjà ouvert et dans ce cas passer par un getobject

**master1551** · 10/01/2013, 13h13

Oui tu as le code pour cela

If fichier is open ??

**Oliv-** · 10/01/2013, 14h51

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
if wb.ReadOnly then 
 
Set xla = GetObject(, "Excel.application")
NomFichier = StrReverse(Split(StrReverse(NomFichier1Xls), "\")(0))
 
If xla.Workbooks(NomFichier).Name = NomFichier Then wb= xla.Workbooks(NomFichier)
end if

Transfert data vers excel

VBA Outlook

Discussions similaires

Partager

Partager