预览分页时查找页面区域

问题描述 投票:0回答:1

如下图所示,如果没有设置打印区域,并且a1中有数字1和形状,我想找到每一页的区域。我期待一个好的答案

description here

我遇到这个问题是因为我做了很多未指定的打印工作。

代码是:

    If Sht Is Nothing Then
        Set ws = ActiveSheet
    Else
        Set ws = Sht
    End If
    With ws
        blnLand = CBool(.PageSetup.Order = xlOverThenDown)
        
        strTemp = .PageSetup.PrintArea
        If Len(strTemp) = 0 Then
            Set rngUsed = .Range(.Cells(1), .UsedRange)
'            Debug.Print rngUsed.Address
        Else
            Set rngUsed = .Range(strTemp)
        End If
    End With
    
        With rngUsed '마지막 셀
            Set rngLast = .Cells(.Rows.Count, .Columns.Count)
        End With
Application.Calculation = xlCalculationManual
        m = 1
        ReDim lngV(1 To m)
        lngV(m) = rngUsed.Column
        For Each V In ws.VPageBreaks '열 검사
            m = m + 1
            ReDim Preserve lngV(1 To m)
            lngV(m) = V.Location.Column
            Debug.Print "V.Location.Column=" & V.Location.Column
        Next V
        m = m + 1
        ReDim Preserve lngV(1 To m)
        lngV(m) = rngLast.Column + 1 '더미
            
        m = 1
        ReDim lngH(1 To m)
        lngH(m) = rngUsed.Row
        For Each H In ws.HPageBreaks '행 검사
            m = m + 1
            ReDim Preserve lngH(1 To m)
            lngH(m) = H.Location.Row
            Debug.Print "H.Location.Row=" & H.Location.Row
        Next H
        m = m + 1
        ReDim Preserve lngH(1 To m)
        lngH(m) = rngLast.Row + 1 '더미
            
        lngU = UBound(lngH) - 1
        lngUs = UBound(lngV) - 1
            m = 0
        If blnLand Then '세로 방향인 경우
            For y = 1 To lngU
                For x = 1 To lngUs
                    m = m + 1
                    If m >= lngF And m <= lngT Then
                        Set rngCur = Range(ws.Cells(lngH(y), lngV(x)), ws.Cells(lngH(y + 1) - 1, lngV(x + 1) - 1))
                        If rngPrint Is Nothing Then
                            Set rngPrint = rngCur
                        Else
                            Set rngPrint = Union(rngPrint, rngCur)
                        End If
                        GoTo j1
                    Else
                    End If
                Next x
            Next y
        Else '가로 방향의 경우(열 우선)
            For x = 1 To lngUs
                For y = 1 To lngU
                    m = m + 1
                    If m >= lngF And m <= lngT Then
                        Set rngCur = Range(ws.Cells(lngH(y), lngV(x)), ws.Cells(lngH(y + 1) - 1, lngV(x + 1) - 1))
                        If rngPrint Is Nothing Then
                            Set rngPrint = rngCur
                        Else
                            Set rngPrint = Union(rngPrint, rngCur)
                        End If
                        GoTo j1
                    Else
                    End If
                Next y
            Next x
        End If
j1:

只要找到包含该对象的用户区域,问题似乎很容易解决,但很难。

vba
1个回答
0
投票

即使将对象分组在一起,如果对象很多,也会花费很多时间。

    strTemp = .PageSetup.PrintArea
    Set rngU = .UsedRange
    If Len(strTemp) = 0 Then
        Dim B As Byte
        sCnt = .Shapes.Count
        If sCnt > 1 Then '사진 도형등을 포함하여 사용자범위를 찾는다
            .DrawingObjects.Group
            B = 1
            sCnt = 1
        End If
        If sCnt > 0 Then '사진 도형등을 포함하여 사용자범위를 찾는다
            rxUsdNum = rngU.Rows.Count
            cxUsdNum = rngU.Columns.Count
            For Each Shp In .Shapes
                sr = WorksheetFunction.Max(sr, Shp.BottomRightCell.Row, rxUsdNum)
                sc = WorksheetFunction.Max(sc, Shp.BottomRightCell.Column, cxUsdNum)
            Next
            Set rngUsed = .Range(.Range(.Cells(1), rngU), .Cells(sr, sc))
            If B Then .DrawingObjects.Ungroup
        Else
            Set rngUsed = .Range(.Cells(1), rngU)
        End If
    Else
        Set rngUsed = .Range(strTemp)
    End If
© www.soinside.com 2019 - 2024. All rights reserved.