Erreur de macro en activant plusieurs fichiers EXCEL simultanement

**jabranejb** · 26/11/2012, 18h46

Bonjour;
j'ai créer un macro excel , qui se lance a automatiquement a chaque ouverture d un nouveau fichier excel . le probleme que si on ouvre plusierus fichiers excel simultanement ; le macro " se plante" et voila ques qui m affiche comme ereeur: "microsoft excel attend la fin de l execution d une autre action OLE d une autre application"
SVP , y a t il une solution ?? j'ai pas le choix dans l ouverture des fichier excel puisque c automatique , à chaque export d un nouveau fichier depuis une base de données . merci pour votre aide

Invité · 27/11/2012, 08h48

Bonjour

Si tu ne donnes pas plus d'informations sur le code de cette macro tu n'as pas beaucoup de réponses.

Philippe

**jabranejb** · 27/11/2012, 10h44

Je veut bien , si c'est possible , lancer une macro pour tout les workbook ( classeur) active, c'est à adire, en activons plusieurs fichiers ou classeurs, la macro ce lance pour chaq'un des classeur active.Cette macro permet juste de traiter un seul classeur parmi plusieurs active.Voiçi La macro:

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
Dim TimeToRun
Sub Auto_Open()
     Call scheduleJb
End Sub
Sub scheduleJb()
    TimeToRun = Now + TimeValue("00:00:02")
    Application.OnTime TimeToRun, "MacroAutoJB"
End Sub
 
Sub MacroAutoJB()
 
Dim WordApp As Word.Application
Dim WordDoc As Word.Document
Dim oWdApp As Object  
 
Dim i As Byte
Dim sChemin As String
Dim wb As Workbook
 
  Dim OutApp As Object
  Dim OutMail As Object
  Dim strbody As String
 
On Error Resume Next
Dim nom As String
Dim sName As String
Dim sPath As String
 
On Error Resume Next
Dim j As Integer
j = ActiveSheet.UsedRange.Rows.Count 'count number of lines used in the file
 
Dim n As Byte
n = Cells(1, Columns.Count).End(xlToLeft).Column
wb.Name Like "WCotisation*.xls" Then
 
If ActiveWorkbook.Name Like "Class*.xls" Then
 
user = Environ("username")
sName = ActiveWorkbook.Name
sPath = "C:\Documents and Settings\" & user & "\My Documents\"
sName = Replace(sName, ".xls", "_Word")
MkDir sName
For j = 2 To j 'start the loop the opeation until the next will be for each line used in the file
 
Set WordApp = CreateObject("word.application") 'ouvre session word
nom = Sheets(1).Cells(j, 2)
mail = Sheets(1).Cells(2, n)
Set WordDoc = WordApp.Documents.Open("C:\Documents and Settings\" & user & "\ClassJb.doc")
Set oWdApp = CreateObject("Word.Application")
Set WordDoc = oWdApp.Documents.Open("C:\Documents and Settings\" & user & "\Classjb.doc")
 
For i = 1 To n - 1
'les signets du document Word sont nommés Sig1 , Sig2 , Sig3
WordDoc.Bookmarks("Sig" & i).Range.Text = Cells(j, i) 
Next i
WordDoc.Bookmarks("Signet").Range.Text = Cells(j, 2)
WordDoc.Bookmarks("Sigmail").Range.Text = Cells(j, n)
 
WordDoc.SaveAs Filename:=sPath & sName & "\" & nom & ".doc"
WordApp.Visible = False 'affiche le document Word
 
oWdApp.Quit
ActiveDocument.Close True
WordDoc.Quit  
WordApp.Quit 
 
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    strbody = "Bonjour" & vbNewLine & vbNewLine & _
              "" & vbNewLine & _
              " la fiche technique que vous souhaiter l'exporter a été envoyer le " & Now & " par " & 
 
Environ("UserName") & vbNewLine & vbNewLine & _
              "Ce mail est généré automatiquement" & vbNewLine & _
               "" & vbNewLine & _
              "Veuillez ne pas repondre" & vbNewLine & _
              ""
    On Error Resume Next
    With OutMail
        .To = mail
        .Cc = ""
        .Bcc = ""
        .Subject = nom
        .Body = strbody
        .Attachments.Add (sPath & sName & "\" & nom & ".doc")
         .Send
    End With
    On Error GoTo 0
     Set OutMail = Nothing
    Set OutApp = Nothing
Next j
Application.Quit
End If
 
Sub auto_close()
    On Error Resume Next
   Application.OnTime TimeToRun, "MacroAutoJB", , False
End Sub

**Oliv-** · 27/11/2012, 11h25

Salut,

Corrige déjà les ActiveWorkbook et autres active...

pourquoi fais tu la même chose en auto_open et auto_close ? et pourquoi déclencher la macro avec ontime et pas directement?

**jabranejb** · 27/11/2012, 14h33

Bonjour Oliv;
Merci pour votre repense , mais j'ai, pas compris qu est ce que je doit changer??

J voulais que sa soit une macro automatique puisque sa va étre enregistrés et mise en place dans un serveur d'application , donc je peut pas donner la main au utilisateur de la declancher directement..

**Oliv-** · 27/11/2012, 15h01

Quand La macro va tourner si c'est noté ActiveWorkbook cela fait le traitement sur le classeur actif. et donc pas forcément sur celui qui a lancé la macro !!

tu peux remplacer par thisworkbook par exemple !

je renouvelle mes questions pourquoi lancer 2 fois la macro à l'ouverture puis à la fermeture du classeur ?

et pourquoi avec un délais ?

**jabranejb** · 27/11/2012, 15h30

je renouvelle mes questions pourquoi lancer 2 fois la macro à l'ouverture puis à la fermeture du classeur ?
et pourquoi avec un délais ?

Vous avez raison olivier pour ces 2 questions; j'ai pas fait attenstion pour le 2 eme lancement du macro à la fermeture, alors je l'ai eliminer et j'ai enlever le delais.

Mais pour le changement de ActiveQWorkbook par ThisWorkbook; le macro ne se declanche pas , plutot elle ne fonctionne pas en changeant ActiveWorkbook par ThisWorkbook ?!!!

Olivier j'ai oublier de noter que la macro est enregistré dans " PERSO.XLS" pour se declancher dans tout les fichiers excel . Désolé

**Oliv-** · 27/11/2012, 15h39

il y a des incohérences

déjà une macro auto_open doit se trouver dans un module standard et pas dans thisworkbook
Bien sûr il faut activer les macros !

par quoi est instancié wb (if wb.name...)

enlève tes ON ERROR RESUME NEXT cela masque tes problèmes!

ensuite ton MkDir sName va créer un dossier mais pas forcèment dans le même dossier que ton fichier. utilise le fullname au lieu de sName = wb.Name

ensuite si wb désigne le classeur actif il ne peut se nommer à la fois
Like "WCotisation*.xls" et Like "Class*.xls"

pourquoi tu as 2 instances de WORD
Set WordApp = CreateObject("word.application")
et
Set oWdApp = CreateObject("Word.Application")

WordDoc.Quit n'est pas une méthode valide

**jabranejb** · 27/11/2012, 16h15

ensuite si wb désigne le classeur actif il ne peut se nommer à la fois
Like "WCotisation*.xls" et Like "Class*.xls"

Je veut pas nommé a la fois un classeur avec 2 nom : en fait , j'ai 2 templates word differents , SI le classeur admet un nom qui commence par " WCotisation" , La macro va copier les données dans un template ( Cotis.doc) sinon dans une template class.doc.. Juste 2 conditions differentes pour le nom du classeur.

pourquoi tu as 2 instances de WORD
Set WordApp = CreateObject("word.application")
et
Set oWdApp = CreateObject("Word.Application")

j'ai 2 instance de WORD parceque le premier va ouvrir le fichier word modele ( template ) et le 2 eme va copiées les données dans un nouveau document word crée.

**Oliv-** · 27/11/2012, 17h00

Voici une version qui fonctionne mais sur le classeur où il se trouve ,dans ton cas ce serait perso.xls, mais comme tu veux que cela s'execute sur les autres claaseurs que tu ouvres il faut utiliser un evenement APPLICATION

dans perso.xls / thisworkbook

Code :

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

1
2
3
4
5
6
7
8
9
Private WithEvents App As Application
 
Private Sub Workbook_Open()
    Set App = Application
End Sub
 
Private Sub App_WorkbookOpen(ByVal Wb As Workbook)
    call MacroAutoJB
End Sub

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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
 
 
 
 
Sub MacroAutoJB()
 
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim oWdApp As Word.Application
 
    Dim i As Byte
    Dim sChemin As String
    Dim wb As Workbook
 
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
 
 
    Dim nom As String
    Dim sName As String
    Dim sPath As String
 
    MsgBox "go"
Stop
    'On Error Resume Next
    Dim j As Integer
 
    Set wb = ThisWorkbook
 
    j = wb.ActiveSheet.UsedRange.Rows.Count    'count number of lines used in the file
 
    Dim n As Byte
    n = wb.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
    If wb.Name Like "WCotisation*.xls" Then
'ton code pour ce cas là
    ElseIf wb.Name Like "Class*.xls" Then
 
        user = Environ("username")
        sName = wb.FullName
        sPath = "C:\Documents and Settings\" & user & "\My Documents\"
        sName = Replace(sName, ".xls", "_Word")
        On Error Resume Next
        MkDir sName
        On Error GoTo 0
        For j = 2 To j    'start the loop the opeation until the next will be for each line used in the file
 
 
            nom = wb.Sheets(1).Cells(j, 2)
            mail = wb.Sheets(1).Cells(2, n)
 
            Set oWdApp = CreateObject("Word.Application")
            Set WordDoc = oWdApp.Documents.Open("C:\Documents and Settings\" & user & "\Classjb.doc")
            oWdApp.Visible = True    'False    'affiche le document Word
 
            For i = 1 To n - 1
                'les signets du document Word sont nommés Sig1 , Sig2 , Sig3
                WordDoc.Bookmarks("Sig" & i).Range.Text = Cells(j, i)
            Next i
            WordDoc.Bookmarks("Signet").Range.Text = Cells(j, 2)
            WordDoc.Bookmarks("Sigmail").Range.Text = Cells(j, n)
 
            WordDoc.SaveAs Filename:=sName & "\" & nom & ".doc"  'sPath & sName & "\" & nom & ".doc"
 
            oWdApp.Quit
            '                ActiveDocument.Close True
            '                WordDoc.Quit
 
 
            Set OutApp = CreateObject("Outlook.Application")
 
            OutApp.Session.Logon
            'OutApp.Visible = True
            Set OutMail = OutApp.CreateItem(0)
 
            strbody = "Bonjour" & vbNewLine & vbNewLine & _
                      "" & vbNewLine & _
                    " la fiche technique que vous souhaiter l'exporter a été envoyer le " & Now & " par " & _
                      Environ("UserName") & vbNewLine & vbNewLine & _
                      "Ce mail est généré automatiquement" & vbNewLine & _
                      "" & vbNewLine & _
                      "Veuillez ne pas repondre" & vbNewLine & _
                      ""
            On Error Resume Next
            With OutMail
                .To = mail
                .Cc = ""
                .Bcc = ""
                .Subject = nom
                .Body = strbody
                .Attachments.Add (sName & "\" & nom & ".doc")
                .Send
                '.Display
            End With
 
            On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing
        Next j
        ' Application.Quit
 
    End If
 
 
End Sub

**jabranejb** · 28/11/2012, 13h47

Merci bien pour votre aide ;
en inserant votre macro , j'ai un probleme dans ce niveau:

Code :

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

n = wb.Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column

erreur d execution"1004":la methode "columns de l'objet_global a echoué "

!!

Bonjour;
mon probleme été resolun grace a vous , je tiens a vous remercier , ma macro fonctionne correctement et je reçoi des mails.
Un seul probleme que j'ai pas arrivé a le resoudre , c'est que si je veut que cette macro fnctionne sur un serveur , comment je peut configurer la fonction d envoie des mail.??? la macro fonctione sur le serveur mais pas d envoie des mail.!!??

**jabranejb** · 28/11/2012, 17h15

Bon j'ai avancée dans ma macro , et j'ai bien arrivé à envoyer des mails depuis le serveur à l'aide de cette fontction du macro ; mais le probelem, c'est que si on a plusieurs fichier excel ouvert, on reçoi parfois des mails vide , sa ve dire , sans "attached files" alors que la macro fonctionne convenablement pour un seul classeur actif:

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
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = nom
objMessage.From = "Server@domain.com"
objMessage.To = mail
objMessage.AddAttachment (sPath & sName & "\" & nom & ".doc")
objMessage.TextBody = "Bonjour" & "" & vbNewLine & " Le document que vous souhaiter l'exporter en document WORD a été envoyer le " & Now & vbNewLine & _
              "Ce mail est généré automatiquement" & vbNewLine & _
               "" & vbNewLine & _
             ""
'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 
'Name or IP of Remote SMTP Server
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "10.168.55.150"
'Server port (typically 25)
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
'==End remote SMTP server configuration section==
objMessage.Send

Erreur de macro en activant plusieurs fichiers EXCEL simultanement [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager