Excel 2016 Макро PDF Вывод различного размера в Windows 7 по сравнению с Windows 10 - PullRequest
0 голосов
/ 12 июня 2019

У меня есть макрос, который я написал с помощью Excel 2016 для Windows7 для вывода графиков в виде PDF, а недавно обновил до Windows 10. Теперь графики в выходных PDF-файлах разнесены по-разному в новой системе.Я проверил, что макрос по-прежнему работает должным образом, протестировав его на других ноутбуках с Windows 7 с помощью Excel 2016.

Кто-нибудь знает, меняются ли значения по умолчанию между двумя ОС или какие-либо параметры, которые мне нужно изменить, чтобы получить моймакрос для работы в Windows 10, как в Windows 7?

Я добавил мой код ниже, если он поможет вообще.

Sub exportToPDF()
Dim i As Long, j As Long, k As Long
Dim adH As Long
Dim Rng As Range
Dim FilePath As String: FilePath = ThisWorkbook.Path & "\"
Dim sht As Worksheet, shtSource As Worksheet, wk As Worksheet

Dim SharepointAddress As String
Dim LocalAddress As String
Dim objNet As Object
Dim FS As Object

'===================================================================
'===================================================================
Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "ALL"
Set sht = ActiveSheet
'===================================================================
Application.ScreenUpdating = False
'===================================================================
'Excluding ALL tab, copying all charts from all tabs to ALL
For Each wk In Worksheets
    If wk.Name <> "ALL" And wk.Name <> "Raw data" Then
        Application.DisplayAlerts = False
            j = wk.ChartObjects.Count
                For i = 1 To j
                    wk.ChartObjects(i).Activate
                    ActiveChart.ChartArea.Copy
                    sht.Select
                    ActiveSheet.Paste
                    sht.Range("A" & 1 + i & "").Select
                 Next i
        Application.DisplayAlerts = True
    End If
Next
'===================================================================
'===================================================================
'To set the constant cell vertical increment for separate pages
adH = 40
k = 0
j = sht.ChartObjects.Count
'===================================================================
Application.PrintCommunication = True 'this will allow page settings to update
'To set page margins, adding some info about the file location, tab name and date
With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0)
        .RightMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .Orientation = xlLandscape
        .LeftHeader = "Date generated : " & Now
        .CenterHeader = ""
        .RightHeader = "File name : " & ActiveWorkbook.Name
        .LeftFooter = "File location : " & FilePath & ThisWorkbook.Name
        .CenterFooter = ""
        .RightFooter = ""
        .FitToPagesWide = 1
End With
'===================================================================
'adjusting page layout borders
sht.VPageBreaks.Add sht.[N1]
For i = 40 To j * 40 Step 40
sht.HPageBreaks.Add Before:=sht.Cells(i + 1, 1)
Next i
Columns("A:A").EntireRow.RowHeight = 12.75
Rows("1:1").EntireColumn.ColumnWidth = 9.5
'===================================================================
For i = 1 To j
Set Rng = ActiveSheet.Range("A" & (1 + k * adH) & " :M" & (40 + k * adH) & "")
    With ActiveSheet.ChartObjects(i)
        .Height = Rng.Height
        .Width = Rng.Width
        .Top = Rng.Top
        .Left = Rng.Left
    End With
    ActiveSheet.PageSetup.PrintArea = "$A$1:$M" & (40 + k * adH) & ""
 k = k + 1
Next i
'===================================================================
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath & Format(Now(), "mm-dd-yy") & "_Dashboards", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'===================================================================

Application.DisplayAlerts = False
ThisWorkbook.Sheets("ALL").Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...