[VBA] business object et selection block

Version imprimable

18/09/2007, 14h38
munity

[VBA] business object et selection block

bonjour à tous,

voila des heures que je cherche le moyen pour sélecionner un block spécifique sur un rapport afin de lui affecter un filtre (le tout par vba évidemment)
j'ai bien trouvé ci dessous les fonctions pour isoler un document et un onglet mais je bute sur les tableaux que contienne cet onglet
Dim DocObj As busobj.Document ' l'Object Document
Set DocObj = ActiveDocument ' récupère le document actif
Dim RepObj As busobj.Report ' l'Object Rapport
Set RepObj = ActiveReport ' récupère le rapport actif

y aurait il une âme charitable pour m'aider

merci

désolé pour le webmaster mais j'ai ouvert un autre fil ne sachant bien utilisé l'interface du site

munity

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
 
Peut-être une piste ...
Dim objDoc As busobj.Document 
Dim objStruct As busobj.SectionStructure 
Dim objStructItem As busobj.ReportStructureItem 
Dim objBlock As busobj.BlockStructure 
Dim objPivot As busobj.Pivot 
Dim objDocVar As busobj.DocumentVariable 
Dim vars As DocumentVariables 
Dim var As DocumentVariable 
 
' ----------START FOR CELL LOOP ------ 
    Set doc = Application.ActiveDocument 
    Set vars = doc.DocumentVariables 
    Set objDoc = Application.ActiveDocument 
    For Each objRep In objDoc.Reports 
        Set objStruct = objRep.GeneralSectionStructure 
        ObjectCounter = 1 
 
        For Each objStructItem In objStruct.Body 
                Select Case objStructItem.Type 
                    Case boCell 
                            Select Case ObjectCounter 
                                Case 2 
                                    DOC_NAME = objStructItem.Variable.Formula 
                                Case 6 
                                    REPORT_PROMPT = objStructItem.Variable.Formula 
                                Case 7 
                                    DOC_CATEGORY = objStructItem.Variable.Formula 
                                Case 10 
                                    SQL_STRING = objStructItem.Variable.Formula 
                                Case 11 
                                    CONNECTION_STR = objStructItem.Variable.Formula 
                                Case 14 
                                    EXCH_DOMAIN = objStructItem.Variable.Formula 
                                Case 16 
                                    PROMPT_VALUE = objStructItem.Variable.Formula 
                                Case 18 
                                    USER_GROUP = objStructItem.Variable.Formula 
                            End Select 
                End Select 
                ObjectCounter = ObjectCounter + 1 
        Next 
    Next 
    ' Initialising Parameters From the Report 
 
    'MsgBox CONNECTION_STR 
    'MsgBox EXCH_DOMAIN 
    'MsgBox DOC_NAME 
    'MsgBox REPORT_PROMPT 
    'MsgBox DOC_CATEGORY 
    'MsgBox SQL_STRING 
    'MsgBox PROMPT_VALUE 
    'MsgBox USER_GROUP 
' ----------END FOR CELL LOOP ------

18/09/2007, 16h08
munity

ok

merci pour la piste

je teste et te tiens au courant

munity
18/09/2007, 16h49
munity

cher BRUNO2R

il me semble que ta soluce corresponde à mon besoin
en fait j'avais trouvé les bonnes instructions mais placé au mauvais endroit:(:(

encore une petite question
j'applique à ces tableaux 2 filtres avec la méthode
RepObj.AddComplexFilter...
seulement je souhaiterai appliqué un filtre spécifique au tableau 1
et 1 second au tableau 2
les valeurs de chacun des filtres sont bien entendu différentes
existe t il une instruction permettant non pas un filtre global mais sur un tableau spécifique
merci de ton aide par avance et
surtout merci pour le déblocage déjà apporté
19/09/2007, 08h27
Bruno2r

Salut,
J'ai déjà utilisé en VB le AddComplexFilter mais sur un Report. J'ai vérifié dans l'explorateur d'objets VB AddComplexFilter n'est signalé que comme membre de Report. Et pourtant on le fait "à la main".
As tu essayé de lister tous les objets BlockStructure de ton report à l'aide des index et toutes leurs propriétés pour voir si ton filtre appliqué manuellement apparait ...
Je ne peux pas t'en dire plus n'ayant pas eu à le faire au niveau d'un tableau.
19/09/2007, 09h25
munity

salut BRUNO2R

merci de ta réponse, mais je pense que j'ai tout tenté et malheureusement n'ai pas trouvé je reste persuadé qu'il y a une soluce pourtant
enfin, en informatique l'avantage c qu'il y a toujours plusieurs solutions possibles
donc ma solution est de créer 2 nouvelles requêtes avec les mêmes objets mais pas les mêmes conditions et enfin de regrouper celle ci dans un tableau recap (en espérant ne pas avoir d'autres effets auxquels je n'aurais pas pensé)
je te joins la macro que j'utilise afin de pouvoir automatiser soit en lancant la macro manuellement soit en utilisant le broadcast.
encore merci de d'être penché sur mon problème
Sub Automate()

On Error GoTo Err_Sub

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim Fichier
Dim destPath, racinePath, sParamFile, sDestFile, SFormat As String
Dim DocObj As busobj.Document
Dim RepObj As busobj.Report
Dim RepObjs As busobj.Reports
Dim objStructItem As busobj.ReportStructureItem
Dim mesParametres(3) As String
Dim maDate As String, monAnnee As String
Dim ParFil1, ParFil2
'paramétrage
racinePath = "\\SRVFS3\Presse\Extraction comptage\10 - Fichiers .var\"
sDestFile = ActiveDocument.Name
destPath = "C:\Documents and Settings\MalbrancDa\Bureau\"
sParamFile = "FichierParametrages.var"
SFormat = ".xls"

Set DocObj = ActiveDocument
Set RepObj = ActiveReport
Set RepObjs = ActiveDocument.Reports

'création répertoire si nécessaire
On Error GoTo Err_Mkdir
MkDir destPath
On Error GoTo Err_Sub

'ouverture et lecture fichier de param
Set Fichier = CreateObject("Scripting.FileSystemObject")
Set FichierParam = Fichier.OpenTextFile(racinePath & sParamFile, ForReading)
While FichierParam.AtEndOfStream <> True
fichierligne = FichierParam.ReadLine
If Trim(fichierligne) <> "" Then 'test de ligne vide
'lecture des paramètres du fichier
lesparametres = Split(fichierligne, ".") 'Création du tableau - La valeur de l'indice commence à 0
mesParametres(0) = lesparametres(0)
mesParametres(1) = lesparametres(1)
mesParametres(2) = lesparametres(2)
ParFil1 = lesparametres(3)
ParFil2 = lesparametres(4)
'affectation des paramètres au rapport
Set AppBO = Application
Set mesVariables = AppBO.ActiveDocument.Variables
Counter = 0
For Each maVariable In mesVariables
maVariable.Value = mesParametres(Counter) 'Counter représente le champ et Counter+1 représente la valeur
Counter = Counter + 1 'Incrémente le compteur.
Next
'rafraîchissement du rapport
AppBO.Interactive = False
AppBO.ActiveDocument.Refresh
AppBO.Interactive = True
'Mise en place des filtres dynamiques
For Each RepObj In RepObjs
Set objStruct = RepObj.GeneralSectionStructure
If lesparametres(0) = "GAD" Then
For Each objStructItem In objStruct.Body
Nom = objStructItem.Name
If RepObj.Name = "COMPTAGE SPECIFIQUE" Then
If objStructItem.Name = "COMPTAGE1" Then
If ParFil2 = "" Then RepObj.AddComplexFilter "Offre", "=(0=0)"
If ParFil2 <> "" Then RepObj.AddComplexFilter "Offre", "=<Offre>DansListe(" & ParFil2 & ")"
RepObj.ForceCompute
End If
If objStructItem.Name = "COMPTAGE2" Then
If ParFil2 = "" Then RepObj.AddComplexFilter "Offre", "=(0=0)"
If ParFil2 <> "" Then RepObj.AddComplexFilter "Offre", "=Non(<Offre>DansListe(" & ParFil2 & "))"
RepObj.ForceCompute
End If
End If
Next
Else
If ParFil1 = "" Then RepObj.AddComplexFilter "Offre", "=(0=0)"
If ParFil1 <> "" Then RepObj.AddComplexFilter "Offre", "=Non(<Offre>DansListe(" & ParFil1 & "))"
RepObj.ForceCompute
End If
Next
'enregistrement rapport
filename = sDestFile & " - " & mesParametres(0) & " Echéance " & mesParametres(1) & " à " & mesParametres(2) & SFormat
filename = destPath & filename
AppBO.ActiveDocument.SaveAs filename, 1 'Enregistre dans un fichier XLS

'Supprime l'intégralité des filtres dans le document
For Each RepObj In RepObjs
RepObj.AddComplexFilter "Offre", "=(0=0)"
RepObj.ForceCompute
Next
End If 'fin du test de ligne vide
Wend

Exit_Sub:
AppBO.Interactive = True
Set AppBO = Nothing
' MsgBox "Terminé sans erreur"
Exit Sub
Err_Sub:
AppBO.Interactive = True
Set AppBO = Nothing
MsgBox Err.Description
Err_Mkdir:
Resume Next
End Sub

Public Function Split(ByVal sString As String, sDelimiter As String, Optional iCompare As Long = vbBinaryCompare) As Variant
Dim sArray() As String, iArrayUpper As Integer _
, iPosition As Integer
iArrayUpper = 0
iPosition = InStr(1, sString, sDelimiter, iCompare)
Do While iPosition > 0
ReDim Preserve sArray(iArrayUpper)
sArray(iArrayUpper) = Left$(sString, iPosition - 1)
sString = Right$(sString, Len(sString) - iPosition)
iPosition = InStr(1, sString, sDelimiter, iCompare)
iArrayUpper = iArrayUpper + 1
Loop
ReDim Preserve sArray(iArrayUpper)
sArray(iArrayUpper) = sString
Split = sArray
End Function

Trouvé sur
http://www.forumtopics.com/busobj/po...quote&p=371970

Code:

1
2
3
4
5
6
You will quickly learn that not all "interactive" functions are supported by the SDK.  Table-level filters are an example ... simply not supported.
Well, at least not directly.  The trick is to create a document variable to use as the filter, and then use VBA to dynamically change the .Formula property of the document variable.  Let me give an example:
[list]Create a document variable named myFilter, and give it a formula like = <State> = "CA".
Now set a table level filter using the new variable, and choose True (or maybe it's a 1) for the filter value.
Then use VBA to change the .Formula property of the document variable to say = <State> = "TX".
You haven't change the table filter (it's still "hardcoded" to True), but the formula that evaluates to True / False does change.

20/09/2007, 20h25
munity

bonsoir bruno2r

merci pour ta proposition
mais comme je l'ai dit j'ai réaliser 2 autres requêtes puis créer 2 blocs avec mes valeurs
j'ai ensuite masquer les colonnes d'un des 2 blocs pour faire penser qu'il ne s'agisse que d'un seul bloc
la solution proposé je ne suis pas certain de la comprendre (pas trop à l'aise avec l'anglais) enfin je pense qu'avec un peu de persevérance cela serait possible mais là j'ai plein d'autres rapport à automatiser avec macro et fichier.var donc je mets en stand by ta proposition

encore merci
au fait est ce que mon code va pouvoir te servir
si tu lis le vba comme je le suppose tu as du remarqué qu'il y avait une fonction qui permet de mettre à jour des invites de requête dynamiquement par l'intermédiaire d'un fichier .var (séparateur ".")
c vraiment génial..
j'avoue que je commence à developper sous bo avec vba (je suis plus à l'aise avec excel) et pense réellement que peu de choses sont impossibles à l'aide de macro
munity