У меня есть макрос, который я написал с помощью 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