VBA Slicercache экспорт PDF l oop ломая Excel - PullRequest
Новая
       9

VBA Slicercache экспорт PDF l oop ломая Excel

0 голосов
/ 16 апреля 2020

Я новичок в VBA, и я пытался создать макрос, где у нас есть список центров затрат (всего 385), и идея заключается в том, чтобы go через них один за другим через слайсер , После того, как каждое значение было выбрано, оно будет PDFed, затем перейдет к следующему. Первый раз, когда я запустил его, он работал первые 20, потом он разбил мой Excel, затем во второй раз он побежал 24 и снова упал, и так далее, и так далее. Сам по себе cra sh не выдает никаких сообщений об ошибках, он просто закрывается в Excel.

Я использовал как с отображением предупреждений, так и без них, но с одним и тем же результатом.

Любая помощь очень ценится.

Мой код ниже: 

Sub Macro_test1()

Dim strGenericFilePath     As String: strGenericFilePath = "C:\Users\"
Dim strYear                As String: strYear = Year(Date) & "\"
Dim strMonth               As String: strMonth = MonthName(Month(Date)) & "\"
Dim strDay                 As String: strDay = Format(Date, "dd.mm.yyyy") & "\"


Dim IntSliceCount          As Integer
Dim IntLoop                As Integer
Dim SliceLoop              As Integer
Dim Slice                  As SlicerItem
Dim sC                     As SlicerCache

Set sC = ActiveWorkbook.SlicerCaches("Slicer_CostCentre")

'Application.DisplayAlerts = False
'Application.ScreenUpdating = False

  'This reminds the user to only select the first slicer item
   If sC.VisibleSlicerItems.Count <> 1 Or sC.SlicerItems(1).Selected = False Then
      MsgBox "Please only select first cost centre from slicer in 'Summary+Air' tab"
      Exit Sub
   End If


For i = 1 To sC.SlicerItems.Count

    'Do not clear filter as it causes to select all of the items (sC.ClearManualFilter)

    sC.SlicerItems(i).Selected = True
    If i <> 1 Then sC.SlicerItems(i - 1).Selected = False


    'Debug.Print sI.Name
    'Add export to PDF code here
    With sheet1.PageSetup

    .PrintArea = sheet1.Range("A1:V91" & lastRow).Address

    .FitToPagesWide = 1
    .FitToPagesTall = 1

    End With

    sheet2.Range("F7") = sC.SlicerItems(i).Name

   ' Check for year folder and create if needed
If Len(Dir(strGenericFilePath & strYear, vbDirectory)) = 0 Then
 MkDir strGenericFilePath & strYear
End If
' Check for month folder and create if needed
If Len(Dir(strGenericFilePath & strYear & strMonth, vbDirectory)) = 0 Then
 MkDir strGenericFilePath & strYear & strMonth
End If
' Check for date folder and create if needed
If Len(Dir(strGenericFilePath & strYear & strMonth & strDay, vbDirectory)) = 0 Then
 MkDir strGenericFilePath & strYear & strMonth & strDay
End If

' Save File

sheet1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:= _
strGenericFilePath & strYear & strMonth & strDay & sheet2.Range("F7").Text & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Next

'Application.DisplayAlerts = True
'Application.ScreenUpdating = True

End Sub
...