|
请查收附件及动态图,你看OK不?
关于你提到的第2点.B或者C列,第5行开始,每页打印5行“合并单元格”。
也会遇到合并单元格被拆分的时候。
还是采取如果打印的时候,有一个合并单元格,被分成前页一半,后页一半,移到下页打印
这样一来就不能每页保证5行“合并单元格”了
以下是代码
Sub 打印和调整图片()
Dim dic, r%, i%, k%, j%, p%, rng As Range
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary") '建立字典dic
r = Cells(Rows.Count, 2).End(xlUp).Row 'B列非空单元格的行号
ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.PrintTitleRows = ""
ActiveSheet.PageSetup.PrintArea = "$C$5:$K$" & r '设置列印区域
ActiveSheet.PageSetup.PrintTitleRows = "$1:$4" '设置列印标题
ActiveSheet.ResetAllPageBreaks '重设分隔符
For i = 5 To r - 8
If i <= r - 8 Then
If Range("L" & i).MergeCells Then
dic(i) = k + 1 '合并单元格的行号装入字典
i = Mid(Range("L" & i).MergeArea.Address, InStrRev(Range("L" & i).MergeArea.Address, "$") + 1) '合并单元格右下脚的行号
End If
End If
Next i
Application.Goto Range("B" & r + 1), True '滚动条到B列非空单元格的下一行
j = ActiveSheet.HPageBreaks.Count '水平分隔符的数量
For p = 1 To j '在所有的水平分隔符中循环
Set rng = [C:C].Find(ActiveSheet.HPageBreaks(p).Location, LookAt:=xlWhole) '分隔符所在的位置
If dic.Exists(rng.Row) Then ActiveSheet.HPageBreaks.Add Before:=Range("C" & rng.Row) '分隔符所在位置的合并单元格的行号在字段中存在时,添加分隔符
Next p
Application.Goto Range("B1"), True '滚动条到B1
Call 图片居中
MsgBox "OK!", 64, "提示"
Application.EnableEvents = False '禁止事件
If (MsgBox("打印前是否预览?", vbYesNo, "提示")) = vbNo Then
On Error Resume Next
ActiveWindow.SelectedSheets.PrintOut Copies:=1 '打印1份
Else
ActiveSheet.PrintPreview '打印预览
End If
Application.EnableEvents = True '启用事件
End Sub
Sub 图片居中()
Dim Shp As Shape, ad$, r%, c%
For Each Shp In Sheet6.Shapes
If Shp.Type = msoPicture Then '为图片时
ad = Replace(Shp.BottomRightCell.Address, "$", "") '获取图片右下脚所在的单元格地址
If Range(ad).MergeCells Then '为合并单元格时
r = Range(ad).MergeArea.Row '合并单元格的行号
c = Range(ad).MergeArea.Column '合并单元格的列号
End If
With Shp '位置和大小
.LockAspectRatio = msoFalse '取消纵横比
.Placement = xlMoveAndSize '大小和位置随单元格而变
.Height = Cells(r, c).MergeArea.Height - 30 '高
.Width = Cells(r, c).MergeArea.Width - 30 '宽
.Left = Cells(r, c).MergeArea.Left + (Cells(r, c).MergeArea.Width - .Width) / 2 '左
.Top = Cells(r, c).MergeArea.Top + (Cells(r, c).MergeArea.Height - .Height) / 2 '顶
End With
End If
Next Shp
End Sub
|
|