Как вставить специальный сохраняющий формат в новую книгу в VBA - PullRequest
Новая
       18

Как вставить специальный сохраняющий формат в новую книгу в VBA

0 голосов
/ 27 мая 2019

Я хотел бы скопировать и вставить специальный (значения & формат ) диапазон от книги A до книги B. Проблема в том, что значения вставлены, но не в формате

Я перепробовал все PasteSpecial, но ничего из этого не сработало ... 

Sub Macro_copy_paste_pivot()
    Dim date_report As String
    Dim appExcel As Excel.Application
    Dim XLBook As Workbook

    Set appExcel = CreateObject("Excel.Application")
    Set XLBook = appExcel.Workbooks.Add
    date_report = WorksheetFunction.WorkDay(Date, -1)
    date_report = Format(date_report, "yyyy-mm-dd")

    ' COPY and PASTE the pivot EXO
    Worksheets("Pivot EXO").Activate
    ActiveSheet.PivotTables("Pivot EXO").PivotFields( _
        "[Context].[AsOfDate].[AsOfDate]").VisibleItemsList = Array( _
        "[Context].[AsOfDate].&[" & date_report & "T00:00:00]")

    Range("P7:A24").Copy
    XLBook.Sheets.Add.Name = "EXO"
    XLBook.Worksheets("EXO").Range("P7:A24").PasteSpecial Paste:=xlPasteFormats

End Sub

Итак, как мне вставить формат из книги A в книгу B?

Ответы [ 2 ]

0 голосов
/ 27 мая 2019

Я решил свою проблему.

Проблема заключалась в том, что я создал новое Excel.Application . С кодом ниже, моя специальная вставка отлично работает.

Но я не понимаю, почему xlPasteFormats не работает, когда вы вставляете в другое Excel.Application ... 

Sub Macro_copy_paste_pivot()
    Application.ScreenUpdating = False
    Dim date_report As String
    Dim XLBook As Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook

    Set XLBook = Workbooks.Add
    date_report = WorksheetFunction.WorkDay(Date, -1)
    date_report = Format(date_report, "yyyy-mm-dd")

    ' COPY and PASTE the pivot EXO
    wb.Worksheets("Pivot EXO").PivotTables("Pivot EXO").PivotFields( _
        "[Context].[AsOfDate].[AsOfDate]").VisibleItemsList = Array( _
        "[Context].[AsOfDate].&[" & date_report & "T00:00:00]")
    wb.Worksheets("Pivot EXO").Range(wb.Worksheets("Pivot EXO").Range("P7"), wb.Worksheets("Pivot EXO").Cells(Rows.count, 1).End(xlUp)).Copy
    XLBook.Sheets.Add.Name = "EXO"
    XLBook.Worksheets("EXO").Range("A1").PasteSpecial xlPasteValues
    XLBook.Worksheets("EXO").Range("A1").PasteSpecial xlPasteFormats

    ' Save and update the screen
    XLBook.SaveAs ("F:\path\Pivot_GOP_SCN_PAIR " & date_report & ".xlsx")
    XLBook.Close SaveChanges:=True
    Application.ScreenUpdating = True
End Sub
0 голосов
/ 27 мая 2019

Ну, в общем, значения в диапазоне сводок, которые вы копируете, вообще не форматируются, это только стиль таблицы сводок, который показывает их форматирование.

Один из способов - скопировать ваши значения и затем преобразовать вашископируйте значения в таблицу и примените то же форматирование, что и в вашей сводной таблице (подробности см. в комментариях): 

Sub Macro_copy_paste_pivot()
    Dim date_report As String
    Dim appExcel As Excel.Application
    Dim XLBook As Workbook, XLBookSource As Workbook    'Declare your source workbook too

    Set appExcel = CreateObject("Excel.Application")
    Set XLBookSource = ThisWorkbook                     'Set the source workbook.. alternatively use ActiveWorkbook or specific book
    Set XLBook = appExcel.Workbooks.Add
    date_report = WorksheetFunction.WorkDay(Date, -1)
    date_report = Format(date_report, "yyyy-mm-dd")

    ' COPY and PASTE the pivot EXO
    XLBookSource.Worksheets("Pivot EXO").PivotTables("Pivot EXO").PivotFields( _
        "[Context].[AsOfDate].[AsOfDate]").VisibleItemsList = Array( _
        "[Context].[AsOfDate].&[" & date_report & "T00:00:00]")

    Range("P7:A24").Copy
    XLBook.Sheets.Add.Name = "EXO"
    With XLBook.Worksheets("EXO")
        .Range("P7:A24").PasteSpecial Paste:=xlPasteValues
        .ListObjects.Add(xlSrcRange, .Range("P7:A24"), , xlYes).Name = "TableNameWhatever"  'Add a table for this range.. note this adds headers as well, review as needed
        .ListObjects("TableNameWhatever").TableStyle = XLBookSource.Worksheets("Pivot EXO").PivotTables("PivotTable1").TableStyle2  'Give the same style as the pivot table
    End With
End Sub
...