[VBA] réaliser un export paramétré

[stattus]

Bonjour,

En parcourant le forum, j'ai decouvert un de tes topics sur Bo dont le dernier post date du 19/05/2006.
Dans tes posts, tu dis que tu utilises vb pour demander des parametres à l'utilisateur et ensuite rafraichir un rapport existant avec ces parametres et réaliser un export...
Novice sous Bo, je souhaite réaliser des choses similaires (exploitation d'un rapport qui serait rafraichit en fonction de parametres saisit par l'utilisateur). J'envisage differentes pistes (creation de formulaires, boite de dialogue,...) et t'as facon de proceder en fait partie.
De mon côté je n'ai aucune docs sur le vb de BO et je rame un peu..
te serait-il possible de m'envoyer ton code source afin de m'aider et de m'aiguiller sur l'exploitation (code) des objets de BO..

merci d'avance.

[pc75]

Bonjour,

Je prépare ça dans la journée.

[pc75]

Pour les invites :

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
 
    Dim boDoc AS busobj.Document
    Dim bo AS busobj.Application
    Dim ReportName AS String
    Dim promptName AS busobj.Variable
    Dim promptValue AS String
 
    Screen.MousePointer = vbHourglass
 
    ReportName = txtRapport.Text
 
    ON Error Resume Next
    SET bo = CreateObject("BusinessObjects.Application.6")
    bo.Interactive = False
    bo.LoginAs User, Pwd, False
    IF Err Then
        ON Error GoTo 0
        bo.Quit
        SET bo = Nothing
        Screen.MousePointer = vbDefault
        MsgBox "Paramètres de connexion invalides." & vbCrLf & Err.Description, vbOKOnly, "Scheduler BO - Connexion"
    End IF
 
    SET boDoc = bo.Documents.Open(ReportName, True, False)
    IF Err Then
        ON Error GoTo 0
        bo.Quit
        SET bo = Nothing
        Screen.MousePointer = vbDefault
        MsgBox "Erreur :" & vbCrLf & Err.Description, vbOKOnly, "Scheduler BO - Connexion"
        Exit Sub
    End IF
 
    ' Récupération des invites (texte + valeur)
    NbInvite = 0
    For i = 1 To boDoc.Variables.Count
        If Right(boDoc.Variables.Item(i).Name, 1) = ":" Then
            NbInvite = NbInvite + 1
            ReDim Preserve TexteInvite(NbInvite)
            ReDim Preserve ValeurInvite(NbInvite)
            TexteInvite(NbInvite) = boDoc.Variables.Item(i).Name
            ValeurInvite(NbInvite) = boDoc.Variables.Item(i).Value
        End If
    Next i
    ' Affichage des invites à l'utilisateur
    For i = 1 To NbInvite
        ValeurInvite(i) = InputBox(TexteInvite(i), "Valeur ?", ValeurInvite(i))
    Next i
    boDoc.Close
    Set boDoc = Nothing
    bo.Quit
    Set bo = Nothing
    Screen.MousePointer = vbDefault

Pour l'éxécution :

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
 
    Dim boDoc AS busobj.Document
    Dim bo AS busobj.Application
    Dim FilePath, ReportName, RepoName, PartFileName AS String
    Dim promptName AS busobj.Variable
    Dim promptValue AS String
 
    Screen.MousePointer = vbHourglass
 
    ReportName = txtRapport.Text
 
    ' Connexion BO
    On Error Resume Next
    Set bo = CreateObject("BusinessObjects.Application.6")
    bo.LoginAs User, Pwd, False
    If Err Then
        On Error GoTo 0
        bo.Quit
        Set bo = Nothing
        Screen.MousePointer = vbDefault
        MsgBox "Paramètres de connexion invalides." & vbCrLf & Err.Description, vbOKOnly, "Scheduler BO - Connexion"
    End If
 
    ' Ouverture du document BO
    SET boDoc = bo.Documents.Open(ReportName, True, False)
    IF Err Then
        ON Error GoTo 0
        bo.Quit
        SET bo = Nothing
        Screen.MousePointer = vbDefault
        MsgBox "Erreur :" & vbCrLf & Err.Description, vbOKOnly, "Scheduler BO - Connexion"
        Exit Sub
    End IF
 
    ' Application des valeur des invites
    For i = 1 To NbInvite - 1
        If Len(Trim(ValeurInvite(i))) > 0 Then
            Set promptName = boDoc.Variables.Add(TexteInvite(i))
            promptName.Value = ValeurInvite(i)
        End If
    Next i
 
    bo.Application.Interactive = False
    boDoc.Refresh
    boDoc.Save
    bo.Interactive = True
    DoEvents
    ' Sélection du rapport (onglet)
    SET repBO = boDoc.Reports.Item(1)
 
    ' Exportation du résultat
    If chkTXT.Value = 1 Then
        repBO.ExportAsText (Mid(ReportName, 1, InStr(ReportName, ".") - 1) & ".txt")
    End If
    If chkXLS.Value = 1 Then
        boDoc.SaveAs Mid(ReportName, 1, InStr(ReportName, ".") - 1) & ".xls"
    End If
    If chkHTM.Value = 1 Then
        boDoc.ExportSheetsAsHtml (Mid(ReportName, 1, InStr(ReportName, ".") - 1) & ".htm")
    End If
    If chkPDF.Value = 1 Then
        boDoc.ExportAsPDF (Mid(ReportName, 1, InStr(ReportName, ".") - 1) & ".pdf")
    End If
 
    Set repBO = Nothing
    boDoc.Close
    Set boDoc = Nothing
    bo.Quit
    Set bo = Nothing
 
    Screen.MousePointer = vbDefault

[stattus]

merci beaucoup pour ton aide!!