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
| Sub DCsaveTGRI()
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("TGRI")
Set F2 = Sheets("CODAGE")
Dim Lig As Long
Application.ScreenUpdating = False
Lig = F1.Cells(Rows.Count, 8).End(xlUp).Row
Set D = CreateObject("scripting.dictionary")
D.CompareMode = vbTextCompare
Dim liste As New Collection
Dim i As Integer
On Error Resume Next
For Each cel In F2.Range("H1")
If F2.Cells(cel.Row, 22) <> "" Then
liste.Add cel.Value, CStr(cel.Value)
End If
Next cel
For Each C In liste: D(C) = "": Next C 'Mise en place des filtres
F1.Range("E9:BL" & Lig).AutoFilter field:=8, Criteria1:=D.keys, Operator:=xlFilterValues
F1.Range("E:J,L:M,T:AA,AC:AE,AL:AM,AO:BB,BD:BG,BJ:BL").EntireColumn.Hidden = True
With F1.PageSetup
ActiveWindow.SmallScroll Down:=12 'Enregistrement sous PDF
Sheets("TGRI").Select
Range("E6:BL").Select
ChDir _
"F:\L'exhydro\Gestion PEI\Dossier communale\" & Sheets("dc").Range("AC1").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"F:\L'exhydro\Gestion PEI\Dossier communale\" & Sheets("dc").Range("AC1").Value & "\" & Sheets("dc").Range("AC3").Value & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End With
' ********************** enlever filtre
If Not F1.AutoFilter Is Nothing Then
If F1.FilterMode Then F1.ShowAllData
F1.AutoFilter.Range.AutoFilter
End If
' afficher colonne
F1.Range("E:J,L:M,T:AA,AC:AE,AL:AM,AO:BB,BD:BG,BJ:BL").EntireColumn.Hidden = False
Application.ScreenUpdating = True
End Sub |
Partager