如下图所示,如果没有设置打印区域,并且a1中有数字1和形状,我想找到每一页的区域。我期待一个好的答案
我遇到这个问题是因为我做了很多未指定的打印工作。
代码是:
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:
只要找到包含该对象的用户区域,问题似乎很容易解决,但很难。
即使将对象分组在一起,如果对象很多,也会花费很多时间。
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