Un trio infernal : BI - Excel 2010 - Macro.

Version imprimable

20/02/2013, 11h39
Steph-B

Un trio infernal : BI - Excel 2010 - Macro.

J'ai ecumé google en vain... serez vous mon sauveur?

Contexte :
SSAS 2008
Excel 2010 pour les rapports, je precise toute de suite : infaisable avec repportbuilder.
Les rapports : issue de tableaux croisés dynamique, convertir en formule. (histoire d'avoir des mises en page correcte) Ce qui implique les formules :
"=Membrecube()", "=valeurcube()", etc...
WSS3 - pour le stockage des tableaux Excel 2010

Voici le problème.
Les rapports doivent etre actualisé, publié en PDF, et envoyé par mail à date.

J'ai donc fait, avec mon humble niveau un "robot" en VBA, via excel 2010.
Ce robot a une liste des tableaux / feuilles de calcul a publier et a envoyer par mail.

Son principe est simple ouvrir un rapports, temps de pauses (doevents) le temps que les données s'actualisent, excuter les fonctions et referemer le rapport avant de passer au rapport suivant.

En mode Debug tout ce passe bien. Le rapport s'ouvre, les données s'actualise, les pdf sont generes et envoyés.

Là où cela devient pour le moins étrange, lorsque les macro ne sont pas executées en mode debug, mais en mode automatique il se passe le phenomene suivant :
Ouverture du classeur... pause... Pas d'actualisation des données, à la place des données dans les cellules il apparait le message "#Chargement_Valeur"... les fonctions de pdf sont executées avec le message cité.

Le message #chargement_valeur disparait pour faire place aux données si je stoppe l'execution de la macro. (exemple si je stoppe la macro pendant le temps de pause)

J'ai tenté diverses fonction tel que workbooks.refreshall, activesheet.calculate, etc....
Rien a faire...

une idée pour m'aider?

Bonjour,
Ta macro, ouvre un classeur, actualise les datas, le converti en pdf et envois le pdf en pièce jointe.
C’est bien cela ?
Ton automate ce trouve dans un classeur Excel et c’est lui qui ouvre les autres classeurs et exécute l’enchaînement ?
Bien évidement tu as banni toutes instructions du genre ActiveCell, ActiveSheet, ActiveWorkbook… mais tu as utilisé des objets VB :

Code:

1
2
Dim MyClaseur As Workbook
Set MyClaseur = ActiveWorkbook.Application.Workbooks.Open("c:\??.xls")

Et autres objet vb si tu ne fais pas ça tu vas te perdre dans ton code.
Je préconise toujours d’exécuter ce genre de code dans une nouvelle instance d’Excel.

Code:

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
Private Function RetournClasseur(Fichier As String) As String
Dim T
Dim I As Long
T = Split(Fichier & "\", "\")
For I = UBound(T) To 0 Step -1
    If Trim("" & T(I)) <> "" Then
        RetournClasseur= Trim("" & T(I))
        Exit For
    End If
Next
End Function
Private Sub AddIns_Installed(MonObjet As Object)
For Each cp In MonObjet.Application.AddIns
Debug.Print cp.Name
  If (UCase(cp.Name) = "ANALYS32.XLL") Or (UCase(cp.Name) = "Utilitaire d'analyse") Then
    cp.Installed = False
    cp.Installed = True
    Exit For
  End If
  Next
End Sub
Public Function TraiterClasseur(FichierExcel As String)
    Dim MonObjet As Object
    Dim MyWorkbook As Object
 
   Set MonObjet = CreateObject("Excel.Application")
 
 
 Set MyWorkbook = MonObjet.Workbooks.Open(FichierExcel)
 
 
    MonObjet.Application.DisplayAlerts = False
    MonObjet.Application.Visible = True
    AddIns_Installed MonObjet
    MyWorkbook.Activate
    MyWorkbook.RefreshAll
 
    'Ton code
 
 
    MyWorkbook.Save
    MyWorkbook.Close
    Set MyWorkbook = Nothing
 
 
'    Quitte Excel 
    MonObjet.Application.Quit
    Set MonObjet = Nothing
 
End Function
Sub Exemple()
TraiterClasseur "c:\???.xls"
End Sub

Citation:

Ta macro, ouvre un classeur, actualise les datas, le converti en pdf et envois le pdf en pièce jointe.
C’est bien cela ?

Exactement !

Citation:

Ton automate ce trouve dans un classeur Excel et c’est lui qui ouvre les autres classeurs et exécute l’enchaînement ?

Oui c'est le code de l'automate qui fait toutes les actions.

Citation:

Bien évidement tu as banni toutes instructions du genre ActiveCell, ActiveSheet, ActiveWorkbook… mais tu as utilisé des objets VB :

euh... non...:oops:

Voici mon code...
(je ne suis pas un developpeur pro loin de la...)

Code:

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
Private Sub Workbook_Open()
Call runme
End Sub
 
'---- module 1
 
Private Declare Function GetCommandLineA Lib "kernel32" () As String
 
Sub runme()
 
'Si variable à l'ouverture de fichier excel = /auto > on est en mode robot> execute la macro,
'sinon en mode utilisateur on affiche juste le classeur.
If InStr(1, GetCommandLineA, "/auto") = 0 Then Exit Sub
 
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("liste").Activate
ActiveSheet.Range("A1").Select
Do
'   On parcourt la liste, et on sort si cellule vide.
    ActiveCell.Offset(1, 0).Select
    If Selection.Value = "" Then Exit Do
 
'   Recuperation des valeur : depot lieu de stockage,
'   Classeur nom du fichier excel
'   feuilles : nom de la feuille à traiter
'   Pdf : chemin de depot du pdf
'   MailA, Objet, Message composante du mail.
    depot = Selection.Value
    classeur = Selection.Offset(0, 1).Value
    feuilles = Selection.Offset(0, 2).Value
    pdf = Selection.Offset(0, 3).Value
    MailA = Selection.Offset(0, 4).Value
    objet = Selection.Offset(0, 5).Value
    Message = Selection.Offset(0, 6).Value
 
'Ouverture du classeur
    Workbooks.Open depot + classeur, 3
    ActiveWorkbook.RefreshAll
    Sheets(feuilles).Activate
 
'Pause
    Call wait(60)
 
'PDF
    If pdf <> "" Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=pdf, Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If
 
'Mail
    If MailA <> "" Then
'       Fichier tampon
        Nomtempo = "c:\temp\" + ActiveWorkbook.Name + ".pdf"
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Nomtempo, Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Call Envoi_mail(MailA, objet, Message, Nomtempo)
        cmdshell = "cmd /c del " + Chr(34) + Nomtempo + Chr(34)
        Shell cmdshell, vbHide
    End If
'fin
    ActiveWorkbook.Close SaveChanges:=False
Loop
 
Application.Quit
 
End Sub
 
 
Sub Envoi_mail(Destinataire, Sujet, Message, PJ)
'im iMsg As Object, iConf As Object, Flds As Object
 
Set iMsg = CreateObject("cdo.message")
Set iConf = CreateObject("cdo.configuration")
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.monserveur.fr"
    .Update
End With
 
With iMsg
    Set .Configuration = iConf
    .To = Destinataire
    .From = "noreply@monserveur.fr"
    .Subject = Sujet
    .TextBody = Message
    .AddAttachment PJ
    .Send
End With
 
End Sub
 
Sub wait(attendre)
temps = Time
debut = Minute(temps) * 60 + Second(temps)
Do
    DoEvents
    ecoule = (Minute(Time) * 60 + Second(Time)) - debut
    If ecoule > attendre Then Exit Do
Loop
End Sub

Ceci dit ton code pas de problème jute pour la récupération des paramètres de la ligne de commande. Mais les bonnes pratiques ça ne mange pas de pain.
Si maintenant on est 2 à utiliser les objets VB il y aura toujours du progrès.
Mais je pense qu’on est plus.

Code:

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
 
'fonction proposée par Tony Proctor sur le forum public de Microsoft : microsoft.public.vb.winapi
Private Function GetCmd() As String
   Dim lpCmd As Long
   lpCmd = GetCommandLine()
   GetCmd = Space$(lstrlen(ByVal lpCmd))
   lstrcpy ByVal GetCmd, ByVal lpCmd
End Function
'Le reste est de nous et surtout toi
Private Function RetournClasseur(Fichier As String) As String
Dim T
Dim I As Long
T = Split(Fichier & "\", "\")
For I = UBound(T) To 0 Step -1
    If Trim("" & T(I)) <> "" Then
        RetournClasseur = Trim("" & T(I))
        Exit For
    End If
Next
End Function
Private Sub AddIns_Installed(MonObjet As Object)
For Each cp In MonObjet.Application.AddIns
Debug.Print cp.Name
  If (UCase(cp.Name) = "ANALYS32.XLL") Or (UCase(cp.Name) = "Utilitaire d'analyse") Then
    cp.Installed = False
    cp.Installed = True
    Exit For
  End If
  Next
End Sub
Private Function ExportePdf(MySheet As Worksheet, pdf As String) As Boolean
On Error Resume Next
If pdf <> "" Then
    ExportePdf = True
    MySheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=pdf, Quality:=xlQualityMinimum, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    If Err <> 0 Then
        ExportePdf = False
        Err.Clear
    End If
End If
On Error GoTo 0
End Function
Public Function TraiterClasseur(FichierExcel, MySheet, pdf, MailA, objet, Message)
    Dim MonObjet As Object
    Dim MyWorkbook As Object
    Set MonObjet = CreateObject("Excel.Application")
    Set MyWorkbook = MonObjet.Workbooks.Open(FichierExcel)
 
 
    MonObjet.Application.DisplayAlerts = False
    MonObjet.Application.Visible = True
    AddIns_Installed MonObjet
    MyWorkbook.Activate
    MyWorkbook.RefreshAll
 
    'Ton code
    If ExportePdf(MyWorkbook.Sheets(MySheet), pdf) = True Then
        Envoi_mail MailA, objet, Message, pdf
    End If
 
    'MyWorkbook.Save
    MyWorkbook.Close False
    Set MyWorkbook = Nothing
 
 
'    Quitte Excel
    MonObjet.Application.Quit
    Set MonObjet = Nothing
 
End Function
Private Function Envoi_mail(Destinataire, Sujet, Message, PJ) As String
'im iMsg As Object, iConf As Object, Flds As Object
 On Error GoTo Fin
Set iMsg = CreateObject("cdo.message")
Set iConf = CreateObject("cdo.configuration")
Set Flds = iConf.Fields
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.monserveur.fr"
    .Update
End With
 
With iMsg
    Set .Configuration = iConf
    .To = Destinataire
    .From = "noreply@monserveur.fr"
    .Subject = Sujet
    .TextBody = Message
    .AddAttachment PJ
    .Send
End With
Fin:
Envoi_mail = Err.Description
On Error GoTo 0
End Function
Sub runme()
 
'Si variable à l'ouverture de fichier excel = /auto > on est en mode robot> execute la macro,
'sinon en mode utilisateur on affiche juste le classeur.
 
If InStr(1, GetCmd, "/auto") = 0 Then Exit Sub
 
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("liste").Activate
ActiveSheet.Range("A1").Select
Do
'   On parcourt la liste, et on sort si cellule vide.
    ActiveCell.Offset(1, 0).Select
    If Selection.Value = "" Then Exit Do
 
'   Recuperation des valeur : depot lieu de stockage,
'   Classeur nom du fichier excel
'   feuilles : nom de la feuille à traiter
'   Pdf : chemin de depot du pdf
'   MailA, Objet, Message composante du mail.
    depot = Selection.Value
    classeur = Selection.Offset(0, 1).Value
    feuilles = Selection.Offset(0, 2).Value
    pdf = Selection.Offset(0, 3).Value
    MailA = Selection.Offset(0, 4).Value
    objet = Selection.Offset(0, 5).Value
    Message = Selection.Offset(0, 6).Value
 
TraiterClasseur depot + classeur, feuilles, pdf, MailA, objet, Message
 
 
Loop
 
Application.Quit
 
End Sub
Sub Exemple()
TraiterClasseur "c:\???.xls"
End Sub

Merci !

Bien, Ca marche !

J'ai etudié votre code, je pense avoir compris mes erreurs.
Voici mon code final (un joyeux melange du votre et du mien)

Code:

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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
 
fichier BAT de lancement :
"D:\Program Files\Microsoft Office\Office14\excel.exe"  /e/auto c:\robot\runner-quotidien-V2.xlsm
 
Code fichier Excel :
thisworkbook
 
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (lpString As Any) As Long
Private Declare Function GetCommandLine Lib "kernel32" Alias "GetCommandLineA" () As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, lpString2 As Any) As Long
 
'fonction proposée par Tony Proctor sur le forum public de Microsoft : microsoft.public.vb.winapi
Private Function GetCmd() As String
   Dim lpCmd As Long
   lpCmd = GetCommandLine()
   GetCmd = Space$(lstrlen(ByVal lpCmd))
   lstrcpy ByVal GetCmd, ByVal lpCmd
End Function
 
Private Sub Workbook_Open()
'Si variable à l'ouverture de fichier excel = /auto > on est en mode robot> execute la macro,
'sinon en mode utilisateur on affiche juste le classeur.
If InStr(1, GetCmd(), "/auto") = 0 Then Exit Sub
 
Call runme
End Sub
 
Module1
Sub runme()
 
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("liste").Activate
ActiveSheet.Range("A1").Select
 
Do
'   On parcourt la liste, et on sort si cellule vide.
    ActiveCell.Offset(1, 0).Select
    If Selection.Value = "" Then Exit Do
 
'   Recuperation des valeur : depot lieu de stockage,
'   Classeur nom du fichier excel
'   feuilles : nom de la feuille à traiter
'   Pdf : chemin de depot du pdf
'   MailA, Objet, Message composante du mail.
    depot = Selection.Value
    classeur = Selection.Offset(0, 1).Value
    feuilles = Selection.Offset(0, 2).Value
    pdf = Selection.Offset(0, 3).Value
    MailA = Selection.Offset(0, 4).Value
    Objet = Selection.Offset(0, 5).Value
    Message = Selection.Offset(0, 6).Value
 
'Traitement du rapport
 
    MAJ_Rapport depot, classeur, feuilles, pdf, MailA, Objet, Message
 
Loop
 
Application.Quit
 
End Sub
 
Private Function MAJ_Rapport(Chemin, Fichier, FCalcul, SortiePDF, Destinataire, Sujet, CorpsMessage)
Dim Appli As Object
Dim Rapport As Object
 
'Creation d'un objet Excel, et d'un objet rapport dans l'object excel
Set Appli = CreateObject("Excel.Application")
Set Rapport = Appli.Workbooks.Open(Chemin + Fichier, 3)
Appli.Application.DisplayAlerts = False
Appli.Application.Visible = True
Rapport.Activate
Rapport.RefreshAll
 
'Pause dans la macro, le temps de rafraichir les données.
Call wait(20)
 
'Si sortie PDf demandé (Chemin existant)
If SortiePDF <> "" Then
        Rapport.Sheets(FCalcul).ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=SortiePDF, Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
 
'Si envoie par mail demandé (destinataire existant)
If Destinataire <> "" Then
'       On crée un fichier PDF tempo (la sorite PDF ci dessus n'etant pas obligatoire)
        Nomtempo = "c:\temp\" + Fichier + ".pdf"
        Rapport.Sheets(FCalcul).ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Nomtempo, Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        Call Envoi_mail(Destinataire, Sujet, CorpsMessage, Nomtempo)
        cmdshell = "cmd /c del " + Chr(34) + Nomtempo + Chr(34)
        Shell cmdshell, vbHid
End If
 
' On ferme et on libere les objets.
Rapport.Close SaveChanges:=False
Set Rapport = Nothing
Appli.Application.Quit
Set Appli = Nothing
End Function
 
Sub Envoi_mail(Destinataire, Sujet, Message, PJ)
Dim Imsg As Object
Dim Iconf As Object
Dim Flds As Object
 
Set Imsg = CreateObject("cdo.message")
Set Iconf = CreateObject("cdo.configuration")
Set Flds = Iconf.Fields
 
With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.MonDomaine.fr"
    .Update
End With
 
With Imsg
    Set .Configuration = Iconf
    .To = Destinataire
    .From = "noreply@MonDomaine.fr"
    .Subject = Sujet
    .TextBody = Message
    .AddAttachment PJ
    .Send
End With
 
Set Flds = Nothing
Set Iconf = Nothing
Set Imsg = Nothing
End Sub
 
Sub wait(attendre)
temps = Time
debut = Minute(temps) * 60 + Second(temps)
Do
    DoEvents
    ecoule = (Minute(Time) * 60 + Second(Time)) - debut
    If ecoule > attendre Then Exit Do
Loop
End Sub

Dans le code que vous soumettiez, je n'ai pas pris :
-la fonction "RetournClasseur" : elle n'etait pas utilisée.
-la fonction "Addis_installed" : en l'etat elle n'est pas utile, puisque le Excel est sur un poste serveur, installé une bonne fois pour toute.

Merci de votre aide !