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
| Sub importerBO(Choix As Boolean)
Dim RepObj As busobj.Report
Dim RepObjs As busobj.Reports
Dim objStructItem As busobj.ReportStructureItem
Dim MoisCourant As Integer
Dim VarReq As String
MoisCourant = Format(Now(), "m")
For i = MoisCourant To 1 Step -1
If i = MoisCourant Then
VarReq = Format(DateSerial(Year(Now), MoisCourant + (1 - i), Day(Now)), "yyyymm")
Else
VarReq = VarReq & ";" & Format(DateSerial(Year(Now), MoisCourant + (1 - i), Day(Now)), "yyyymm")
End If
Next
'On définit les variable, et les fichiers excel que l'on va ouvrir
Dim xlsapp As Excel.Application
Set xlsapp = ActiveWorkbook.Application
'On masque le classeur excel, et on désactive les alertes
xlsapp.Visible = False
Application.Interactive = False
Application.DisplayAlerts = False
'On lance l'application BO et la requête que l'on va utiliser
Set buso = CreateObject("BusinessObjects.Application")
user = Environ("username") 'on récupère l'ID de l'utilisateur courant pour l'insérer automatique dans BO
On Error Resume Next
buso.LoginAs user, "", False, enterprise
If (Err.Number > 0) Then
buso.Quit 'on quitte BO
Application.Interactive = True
'On réinitialise les variables
Set buso = Nothing
Set docBO = Nothing
MsgBox "Mauvais mot de passe BO. L'application va se fermer. Veuillez la relancer."
Else
Set docBO = buso.Documents.Open(ActiveWorkbook.Path & "\RDV TMK 3.rep") 'On localise la requête BO
'C:\Users\A3869204\Links\Espaces partagés\Mon Departement - RHA OUTILS COMMERCIAUX ET CRM DPR
'buso.Interactive = False 'Fenêtre date
If Choix = True Then buso.Interactive = False Else buso.Interactive = True
docBO.Variables.Item("AnneeCourante").Value = VarReq
buso.Interactive = False 'Fenetre enregistrer requete
docBO.Reports.Item("Région").ExportAsExcel (ActiveWorkbook.Path & "\Suivi_TMK_Région" & Format(Now(), "dd-mm-yyyy") & ".xls") 'On exporte le résultat de la requête
docBO.Reports.Item("Agence").ExportAsExcel (ActiveWorkbook.Path & "\Suivi_TMK_Agence-" & Format(Now(), "dd-mm-yyyy") & ".xls") 'On exporte le résultat de la requête
buso.Quit 'on quitte BO
Application.Interactive = True
'On réinitialise les variables
Set buso = Nothing
Set docBO = Nothing
End If
xlsapp.Quit
'Set xlsapp = Nothing
End Sub |
Partager