Bonjour ,

Ça fait quelques jours que j'essaye de mettre en place un programme VBA pour ajouter le numéro code région correspondant à chaque fichier généré.
En gros le nom du groupe venant de la variable LIB_GROUPE qui est aussi le filtre est ajouté au rapport sans problème .Mais des que j'ajoute la région la V_CODE_REGION, j'ai
l'erreur
Run-time error 9 . Subscript out of range.
Le nombre des fichiers générés est égale au nombre des régions alors qu'il y a plus de groupes que de régions .

Avez-vous déjà rencontre cette problématique ? D'avance merci pour vos conseils

Ci-dessous la macro.


Code VBA : Sélectionner tout - Visualiser dans une fenêtre à part
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
Public Sub export_reseau()
'ThisDocument.Reports.Item(1).ExportAsPDF "\\frvas010p\public\Echanges de fichiers\Samuel\" & ActiveDocument.Reports.Item(1).Name & "2 .pdf"
ThisDocument.Reports.Item(1).ExportAsPDF "C:\" & ActiveDocument.Reports.Item(1).Name & ".pdf"
End Sub
 
Public Sub export_reseau_par_groupe()
 
Set DCT = ThisDocument
Set RPT = ActiveReport
Set FSO = New Scripting.FileSystemObject
 
 
 
 
Set DirDest = FSO.GetFolder("K:\DSI\alhousseini\")
 
Dim monFiltreVar As DocumentVariable
Dim GroupeVar As DocumentVariable
Dim nb, intNumChoix, ng, intGr As Integer
Dim monFiltreChoix As Variant
Dim RegionNum As Variant
Dim strNextValue As Variant
Dim GrpValue As Integer
 
 
 
For Each RPT In DCT.Reports
'If RPT.Name = "VTE014 Détail Statistiques" Or RPT.Name = "VTE014 pour checker" Or RPT.Name = "VTE014 Détail Statistiques pour CDR National" Then
 ThisDocument.Reports.Item(1).ExportAsText "K:\DSI\alhousseini\" & ActiveDocument.Reports.Item(1).Name & " .txt"
'Else
 
                  '  RPT.ExportAsPDF FSO.GetAbsolutePathName(DirSource) & "\" & RPT.Name
                    Set monFiltreVar = DCT.DocumentVariables("LIB_GROUPE")
                    Set GroupeVar = DCT.DocumentVariables("V_CODE_REGION")
                   ‘V_CODE_REGION c’est le code region qu’ll faut ajouter au fichier apres decoupage ‘
                    monFiltreChoix = monFiltreVar.Values(boUniqueValues)
                    RegionNum = GroupeVar.Values(boUniqueValues)
                    intNumChoix = UBound(monFiltreVar.Values(boUniqueValues))
                    intGr = UBound(GroupeVar.Values(boUniqueValues))
 
                        For nb = 1 To intNumChoix
 
 
                            strNextValue = monFiltreChoix(nb)
                            For ng = 1 To intGr
                             GrpValue = RegionNum(nb)
 
                                Select Case FSO.FolderExists("K:\DSI\alhousseini\Groupe\")
                                    Case Is = True
                                        Set DirSource = FSO.GetFolder("K:\DSI\alhousseini\Groupe\")
                                    Case Is = False
                                        FSO.CreateFolder ("K:\DSI\alhousseini\Groupe\")
                                        Set DirSource = FSO.GetFolder("K:\DSI\alhousseini\Groupe\")
                                End Select
 
 
                         RPT.AddComplexFilter monFiltreVar, "=<LIB_GROUPE> = " & """" & strNextValue & """"
                         RPT.ExportAsPDF (FSO.GetAbsolutePathName(DirSource) & "\" & RPT.Name & " " & strNextValue) & GrpValue
                        ‘GrpValue je l’ajoute à la fin du decoupage ‘
 
                        Next ng
                        Next nb
                    RPT.AddComplexFilter monFiltreVar, "=(1=1)"
                    RPT.ForceCompute
 
               '     RPT.ExportAsPDF "K:\DSI\alhousseini\" & RPT.Name
               '     RPT.ExportAsText "K:\DSI\alhousseini\" & RPT.Name
 
'End If
Next RPT
Set RPT = Nothing
 
'FSO.CopyFile (FSO.GetAbsolutePathName(DirSource) & "\*.*"), DirDest, True
'FSO.DeleteFile (FSO.GetAbsolutePathName(DirSource) & "\*.*"), True
 
Set DirSource = Nothing
Set DirDest = Nothing
Set FSO = Nothing
DCT.Save
Set DCT = Nothing
 
Exit Sub
 
error_olemsg:
Err.Clear
End Sub