我有一个宏,该宏是我在Windows7上使用Excel 2016编写的,用于将图形输出为PDF,最近又升级到Windows10。现在,在新系统上,输出pdf上的图形的间距有所不同。我已经通过使用Excel 2016在其他Windows 7笔记本电脑上对其进行测试来验证该宏仍然可以正常工作。
有人知道两个操作系统之间是否有默认值更改,或者我需要更改其参数才能使宏在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