[VBA]Prompt dans BO / FreeHand SQL [Résolu]

[Sunchaser]

Bonsoir,

J'ai fait quelques recherches et j'ai l'impression d'être tombé sur qqchose d'ennuyeux (pour moi):

Je refait un rapport crée de maniére 'classique' (avec un univers et tout, et tout) mais avec sous l'option FreeHand SQL.
Mon problème est que je dois obtenir un prompt avec une 'LOV' chargée par les valeurs d'un champ, alors qu'il semblerait que les valeurs doivent être 'codée en dur' directement dans la requête ...
Un peu de cette manière:

Code :

1
2
 
@prompt('Choose a report:', 'A', {'choix a', 'choix b', 'choix c'}, 'MONO', 'CONSTRAINED')

Ceci étant tout a fait impensable dans mon cas ...

Qu'est ce qui doit être fait ?
Merci d'avance pour vos conseils

@ +

Petite précision : je suis assez 'nouveau' dans B.O

[bastoonet]

il faut que tu remplace la liste de valeur par la localisation de l'objet !! Il prendra ainsi la liste de valeur de l'objet (par défaut ou définie dans l'univers)

@prompt('Choose a report:', 'A', 'MA_CLASSE\Mon_objet', 'MONO', 'CONSTRAINED')
mais ça c'est plutot au niveau d'une condition prédéfinie dans l'univers

essaye en remplaçant 'MA_CLASSE\Mon_objet' par le code SQL de l'objet (table.champs)

j'ai pas BO sous la main pour vérifer mais ça ressemble à ça....

si non fait un essai de requete avec une invite quelconque sur un objet...et regarde ce que ça te donne coté SQL...puis fait la meme chose !!!
...si je ne me trompe pas..c'est peut etre plutot @variable qu'il faut utiliser au lieu de @prompt....

[Sunchaser]

Envoyé par bastoonet

si non fait un essai de requete avec une invite quelconque sur un objet...et regarde ce que ça te donne coté SQL...puis fait la meme chose !!!
...si je ne me trompe pas..c'est peut etre plutot @variable qu'il faut utiliser au lieu de @prompt....

Merci pour cette première réponse,
Effectivement, c'est exactement ce que j'avais fait, d'ailleurs j'avais un @variable au lieu du @prompt au départ.

J'ai récupéré toutes le SQL d'un rapport basé sur un univers, histoire de bricoler et de voir comment cela fonctionnait dans le mode FreeHand SQL...

Je suis tombé sur un forum british, qui semblait dire qu'effectivement j'allais être un peu coincé -> ici
Qu'en penses tu ?
D'ailleurs, si je comprends bien ce qui est proposé, je n'adhère pas a la solution alternative proposée ( une sorte de Mix entre Univers et FreeHand ? )

Merci de vos avis,
@ +

[Sunchaser]

Bonsoir,

Savez vous si l'on peut efficacement modifier via du VBA le code SQL des requêtes en 'FreeHand SQL' ?

Mon idée est de tenter de travailler sur le SQL dans un évènement comme le 'Before Refresh'.
Je fais tourner une autre requête qui fais simplement un 'SELECT' sur le champs dont les valeurs doivent faire ma L.O.V, et j'exporte le résultat dans un fichier Excel avec la méthode :

Code :

1
2
 
ConvertTo(...)

des objets de type DataProvider.

La suite de l'idée est d'aller lire dans le fichier les valeurs, les charger dans un String (non, non ... pas d'idées mal placées ) en ajoutant les guillemets et virgules, et inserer le tout dans le SQL de la requête, avec une méthode Replace(...) ou équiv dans la gestion des chaines ...
Surtout que j'imaginais facilement localiser le texte a modifier en recherchant les '{' et '}' (avec InStr(...) et Mid(...), par ex ?).
J'ai bien les bonnes valeurs a inserer, mais a priori je n'arrive po a modifier le texte du SQl de la requête ...


Merci de vos conseils éclairés,
@+

[Sunchaser]

Bonsoir,

Ch'tite précision:
-> N'hésitez pas a me dire si je dis des bêtises grosses comme moi ... Je préfère tout envisager que de rester bloqué ....


@+

[Sunchaser]

YYEEEAAAAHHHH !!!




J'ai trouvé ! Pfiou .... Hé ben, on peut dire que j'aurais ramé mais j'ai trouvé.
Mais si ca se trouve, qqu'un avait déja un bout de code du même genre et s'était bien gardé de divulguer sa précieuse découverte.

QQ petites 'API' dans l'éditeur VBA sous B.O et hop, c'est dans la boite.
Le temps que je mette le tout sous une forme présentable et je post cela, histoire de voir si ca plait.

Rooo, mais surtout le plus important : je vais pouvoir aller me défouler sur un site anglais ou je m'étais fait méchamment mouché par un brittish.
Celui la, ce soir, je veux son scalp !
Non, mais.

[Sunchaser]

Re,

Donc l'idée est de travailler - a la base - sur l'évènement BeforeRefresh du document.
Pour les 'grosses lignes' de l'idée:
Je lance une requête sur le/les champs contenant les valeurs devant constituer ma LOV.
(j'ai donc placé une référence a ADOX, dans mon cas)
Je lance un Hook ( WH_CBT ) qui va capter le message précédant l'activation d'une fenêtre ( HCBT_ACTIVATE ).
A l'aide de WindowSpy, j'ai obtenu les valeurs nécessaires a l'identification de la fenêtre permettant la modification du SQL d'un requête, ainsi que de son élément principal -> un Edit.
Je lance donc la méthode Edit() ( de la classe Dataprovider ), ce qui m'ouvre la fenêtre de modification du SQL des requêtes, et le code insère le nouveau texte en remplacement de l'ancien et referme la fenêtre.
Le rafraichissement des données se poursuit avec, cette fois ci, la bonne valeur dans le SQL mais surtout dans la définition du prompt.

Dans ThisDocument:

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
 
Public tSQL AS DataProvider
'ADOX
Dim cnn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
'
Private Declare FUNCTION GetModuleHandle Lib "kernel32.dll" Alias "GetModuleHandleA" ( _
     ByVal lpModuleName AS String) AS Long
'
Private Const WH_CBT = 5
 
Private Sub Document_BeforeClose(Cancel As Boolean)
'
End Sub
 
Private Sub Document_BeforeRefresh(Cancel AS BOOLEAN)
'
Set tSQL = ThisDocument.DataProviders.Item(1)
 
                Dim HinstBusobj As Long
                HinstBusobj = GetModuleHandle("busobj.exe")
                hHook = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, HinstBusobj, 0)
            '
    tSQL.Edit
'
End Sub
 
Private Sub Document_Open()
'
End Sub

Dans un module (je l'ai nommé Gudule, mais on s'en fou ...):
Connection a une base de données sous Oracle, avec ADODB, et requete sur les champs devant constituer la List Of Value.
On récupère les valeurs et on les met en forme afin d'être le nouveau paramètre du prompt; on met chque valeur entre apostrophe et on place une virgule a la suite.
En fin de liste, je fais appel a Left() afin de virer la dernière virgule, devenue inutile; peut être pas tres joli, mais bon ....

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
 
Sub GetData(sVal AS String)
'
Dim strConnect As String
    strConnect = "Provider=MSDAORA;Data Source=MASOURCE;User ID=MONID;Password=MONPASSWORD"
 
'
SET cnn = New ADODB.Connection
    cnn.Open strConnect
SET cmd = New ADODB.Command
    cmd.ActiveConnection = strConnect
        cmd.CommandText = "SELECT DISTINCT CONCAT((MATABLE.MONCHAMP5),CONCAT(' version ',(MATABLE.MONCHAMP6))) AS A_FIELD FROM MABASE.MATABLE"
        cmd.CommandType = adCmdText
        cmd.Execute
'
Set rst = New ADODB.Recordset
    rst.Open "SELECT DISTINCT CONCAT((MATABLE.MONCHAMP5),CONCAT(' version ',(MATABLE.MONCHAMP6))) AS A_FIELD FROM MABASE.MATABLE", strConnect, adOpenStatic
 
        Do Until rst.EOF
        '
                sVal = sVal + "'" + rst.FIELDS(0).Value + "',"
 
        rst.MoveNext
        '
        Loop
cnn.Close
sVal = Left(sVal, Len(sVal) - 1)
'
End Sub

Dans un autre module (lui, c'est Hercule, mais on s'en fou aussi ...):
Ici, c'est le traitement du Hook:

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
 
Private Declare FUNCTION CallNextHookEx Lib "user32" (ByVal hHook AS Long, _
ByVal ncode AS Long, ByVal wParam AS Long, lParam AS Any) AS Long
'
Public Declare Function SetWindowsHookEx Lib "user32" Alias _
"SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal _
hmod As Long, ByVal dwThreadId As Long) As Long
'
Public Declare FUNCTION UnhookWindowsHookEx Lib "user32" (ByVal hHook AS Long) AS Long
'
Public hHook As Long
'
Private Declare FUNCTION FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
     ByVal hWnd1 AS Long, _
     ByVal hWnd2 AS Long, _
     ByVal lpsz1 AS String, _
     ByVal lpsz2 AS String) AS Long
'
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" ( _
     ByVal hwnd As Long, _
     ByVal lpString As String, _
     ByVal cch As Long) As Long
'
Private Declare FUNCTION SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
     ByVal hwnd AS Long, _
     ByVal wMsg AS Long, _
     ByVal wParam AS Long, _
     ByRef lParam AS Any) AS Long
'
Private Const WM_SETTEXT = &HC
Private Const WM_CLOSE = &H10
Public Const HCBT_ACTIVATE = 5
'
Private sLOV AS String
Private text AS String
Private DebText AS String
Private FinText AS String
'
Private hEdit As Long
Private hButton As Long
Private result As Long
'
 
 
'
Public Function CBTProc(ByVal idHook As Long, ByVal wParam As _
Long, ByVal lParam As Long) As Long
'
ON Error Resume Next
'
If idHook < 0 Then
CBTProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
Exit Function
End If
     If idHook = HCBT_ACTIVATE Then
     '
     Dim S AS String
     S = String$(16, Chr$(0))
     Call GetWindowText(wParam, ByVal S, 16)
     IF LEFT$(S, InStr(S, Chr$(0)) - 1) = "Free-hand SQL" Then
            hEdit = FindWindowEx(wParam, 0&, "Edit", vbNullString)
            hButton = FindWindowEx(wParam, 0&, "Button", "&Run")
                    GetData sLOV
                    '
                    DebText = "SELECT DISTINCT " & vbNewLine
                    DebText = DebText & "   MATABLE.MONCHAMP1," & vbNewLine
                    DebText = DebText & "   MATABLE.MONCHAMP2," & vbNewLine
                    DebText = DebText & "   MATABLE.MONCHAMP3," & vbNewLine
                    DebText = DebText & "   CONCAT((MATABLE.MONCHAMP5),CONCAT(' version ',(MATABLE.MONCHAMP6)))" & vbNewLine
                    DebText = DebText & "FROM" & vbNewLine
                    DebText = DebText & "   MABASE.MATABLE," & vbNewLine
                    DebText = DebText & "WHERE" & vbNewLine
                    DebText = DebText & "(CONCAT((MATABLE.MONCHAMP5),CONCAT(' version ',(MATABLE.MONCHAMP6)))=@prompt('Selectionner:', 'A', {"
                    '
                    FinText = "}, 'MONO', 'CONSTRAINED')) "
                    '
                    text = DebText & sLOV & FinText
                    '
                    result = SendMessage(hEdit, WM_SETTEXT, ByVal 0&, ByVal text)
                    result = SendMessage(wParam, WM_CLOSE, ByVal 0&, ByVal 0&)
     End IF
     '
    UnhookWindowsHookEx hHook
    End If
'
CBTProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End FUNCTION
'

Voili ...
Mais y a peut être des choses a redire la dessus, c'est surement loin d'être parfait, mais je suis content de ma petite trouvaille.

@ +