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 cest le code region qull 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 lajoute à 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 |
Partager