Sub PrintActivePage()
Dim VPC As Integer
Dim HPC As Integer
Dim VPB As VPageBreak
Dim HPB As HPageBreak
Dim NumPage As Integer
If ExecuteExcel4Macro("Get.Document(50)") = 0 Then
MsgBox "Excel 找不到列印的内容"
Exit Sub
End If
If ExecuteExcel4Macro("Get.Document(50)") = 1 Then
ActiveSheet.PrintOut From:=1, To:=1, Copies:=1
Exit Sub
End If
'先判断编页码的顺序也就是版面设定的循栏列印或循列列印
If ActiveSheet.PageSetup.Order = xlDownThenOver Then
HPC = ActiveSheet.HPageBreaks.Count + 1
VPC = 1
Else
VPC = ActiveSheet.VPageBreaks.Count + 1
HPC = 1
End If
NumPage = 1
Application.ScreenUpdating = True
ActiveWindow.View = xlPageBreakPreview
For Each VPB In ActiveSheet.VPageBreaks
If VPB.Location.Column > ActiveCell.Column Then Exit For
NumPage = NumPage + HPC
Next VPB
For Each HPB In ActiveSheet.HPageBreaks
If HPB.Location.Row > ActiveCell.Row Then Exit For
NumPage = NumPage + VPC
Next HPB
'取得页数後再判断目前储存格是否在列印范围中
If Intersect(ActiveSheet.UsedRange, ActiveCell) Is Nothing Then
MsgBox "目前储存格不在列印范围中"
Else
MsgBox "目前储存格在第" & NumPage & "页"
End If
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub
Dim VPC As Integer
Dim HPC As Integer
Dim VPB As VPageBreak
Dim HPB As HPageBreak
Dim NumPage As Integer
If ExecuteExcel4Macro("Get.Document(50)") = 0 Then
MsgBox "Excel 找不到列印的内容"
Exit Sub
End If
If ExecuteExcel4Macro("Get.Document(50)") = 1 Then
ActiveSheet.PrintOut From:=1, To:=1, Copies:=1
Exit Sub
End If
'先判断编页码的顺序也就是版面设定的循栏列印或循列列印
If ActiveSheet.PageSetup.Order = xlDownThenOver Then
HPC = ActiveSheet.HPageBreaks.Count + 1
VPC = 1
Else
VPC = ActiveSheet.VPageBreaks.Count + 1
HPC = 1
End If
NumPage = 1
Application.ScreenUpdating = True
ActiveWindow.View = xlPageBreakPreview
For Each VPB In ActiveSheet.VPageBreaks
If VPB.Location.Column > ActiveCell.Column Then Exit For
NumPage = NumPage + HPC
Next VPB
For Each HPB In ActiveSheet.HPageBreaks
If HPB.Location.Row > ActiveCell.Row Then Exit For
NumPage = NumPage + VPC
Next HPB
'取得页数後再判断目前储存格是否在列印范围中
If Intersect(ActiveSheet.UsedRange, ActiveCell) Is Nothing Then
MsgBox "目前储存格不在列印范围中"
Else
MsgBox "目前储存格在第" & NumPage & "页"
End If
ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True
End Sub