一个困扰我N的问题------合并单元格如何完美跨页打印

ColdME · 发表于 2015-9-11 16:56

sjzjtu 发表于 2012-5-3 17:06
手工改缺陷很大，稍微动下，全部要重新来，比如中间插入条数据，修改下页边距啥的。都要重新再调整。

...

Excel自己真的就有这个功能吗？楼主找到没？

aht1999 · 发表于 2015-12-26 13:19

不论是普通表还是透视表，都有这个问题，继续顶起求解啊，各路MVP现身啊

wingcss · 发表于 2017-1-13 08:41

本帖最后由 wingcss 于 2017-1-13 08:44 编辑

同样问题
http://club.excelhome.net/thread-227129-1-1.html

sleepyant · 发表于 2017-1-23 13:59

同样需要解决此问题的方法，学习

Vicel · 发表于 2020-4-3 20:14

sjzjtu 发表于 2012-5-3 16:15
首先谢谢您的顶贴和热情解答。

但这个答案似乎不是完美的，因为不想借助第三方软件或者宏。

宏代码可以实现合并单元格的排序、跨页打印显示问题

Vicel · 发表于 2020-4-5 11:33

永远的野蛮人发表于 2015-8-4 11:05
别怪我挖坟，从2010年开始做统计到现在一直没有完美解决的方案，每次需要调整报出的表格都要花我大量的时间 ...

问题得到解决了吗？

以晴_ · 发表于 2020-5-1 23:30

Vicel 发表于 2020-4-5 11:33
问题得到解决了吗？

我也是还没解决一直在困扰手动好麻烦

andysky · 发表于 2020-6-2 20:00

http://excelbbx.net/Eling8/072HeLiFengYe.htm
单击就好

火冷 · 发表于 2021-9-16 16:51

就这么个问题，竟然一直没人解决。本人是用AutoHotkey的，提供了两种解决方案：
1. 合并单元格移到下页
for hBreak in st.HPageBreaks { ;遍历所有分页符(行)
cell := hBreak.location ;获取下一页A列的第1个单元格
if (cell.address != cell.MergeArea.cells(1).address) { ;为合并单元格中的次单元格
      hBreak.delete() ;删除分布符
      st.HPageBreaks.add(cell.MergeArea.cells(1)) ;添加分页符到合并单元格上方
}
}

2.合并单元格拆分为两行
for hBreak in st.HPageBreaks {
cell := hBreak.location
if (cell.address != cell.MergeArea.cells(1).address) {
      cell1 := cell.MergeArea.cells(1) ;合并单元格的第1个单元格
      rngMerge := cell.MergeArea ;合并单元格区域
      cell.UnMerge
      cell1.AutoFill(rngMerge, 1) ;填充取消合并后的空单元格
      st.range(cell1, cell.offset(-1)).Merge ;合并分页符上方
      st.range(cell, rngMerge.cells(rngMerge.cells.count)).Merge ;合并分页符下方
}
}

Nonenever · 发表于 2021-10-31 23:08

'参考论坛里的资料，自己改了一下
Sub 跨页的合并单元格区域拆分以便打印()
Dim 标题, 选项
标题 = "跨页的合并单元格区域拆分以便打印,需要先设置一下打印区域"
选项 = MsgBox(" 是 : 已经按部分合并单元格局部调整分页符位置" & Chr(10) & " 否 : 在复制工作表上操作" & Chr(10) & "取消:退出并手动调整部分分页符位置 ", 3, 标题)
If 选项 = 6 Then
'
ElseIf 选项 = 7 Then
ActiveSheet.Copy After:=Worksheets(ActiveSheet.Index)
ActiveSheet.Name = "按分页分拆合并单元格" & Format(Now, "mmddhhmmss") & Int((9 * Rnd) + 1)
ElseIf 选项 = 2 Then
ActiveWindow.View = xlPageBreakPreview '打开分页预览，这样会出现分页符
Exit Sub
End If
Application.ScreenUpdating = False '防止眼花了
Application.DisplayAlerts = False '取消了警告提示
Dim rng As Range, A1 As Range, A2 As Range, My_str, My_str_1, My_str_2
Dim R, Nr, Nc, I As Integer, 边框线型, 线型粗细
Dim sht As Worksheet
Set sht = ActiveSheet
Dim Sel_R_Start, Sel_C_Start, Sel_R_End, Sel_C_End
Dim sel As Range
Dim s_str As String
With sht
ActiveWindow.View = xlPageBreakPreview '打开分页预览，这样会出现分页符
If .PageSetup.PrintArea = "" Then
.PageSetup.PrintArea = .UsedRange.Address
End If
s_str = .PageSetup.PrintArea
Set sel = Range(s_str)
Debug.Print sel.Address
Sel_R_Start = sel.Row
Sel_C_Start = sel.Column
Sel_R_End = sel.Rows.Count + sel.Row - 1
Sel_C_End = sel.Columns.Count + sel.Column - 1
If .HPageBreaks.Count > 0 Then '当大于一页时执行代码
For Nr = 1 To .HPageBreaks.Count '循环列举各个水平分页符位置
R = .HPageBreaks(Nr).Location.Row '取得当前列举到的水平分布所在的行的值
I = R '储存行值的备份
For Nc = Sel_C_Start To Sel_C_End
If .Cells(R, Nc).MergeCells = True And .Cells(R, Nc).MergeArea.Cells(1).Row < I Then
With .Cells(R, Nc).MergeArea '.Select '选中当前行的第一列的单元格
My_str = .Cells(1, 1).Value
My_str_1 = Split(.Address, "$")
My_str_1(4) = I - 1
My_str_2 = Split(.Address, "$")
My_str_2(2) = I & ":"
Set A1 = Range(Join(My_str_1, "$"))
Set A2 = Range(Join(My_str_2, "$"))
边框线型 = .Borders(xlEdgeBottom).LineStyle
线型粗细 = .Borders(xlEdgeBottom).Weight
Debug.Print 边框线型
.UnMerge
With A1
.Merge
.Value = My_str
.Borders(xlEdgeBottom).LineStyle = 边框线型
.Borders(xlEdgeBottom).Weight = 线型粗细
End With
With A2
.Merge
.Value = My_str
.Borders(xlEdgeTop).LineStyle = 边框线型
.Borders(xlEdgeTop).Weight = 线型粗细
End With
End With
End If
Next Nc
Next Nr '下一个水平分页符
End If
' ActiveWindow.View = xlPageBreakPreview
ActiveWindow.View = xlNormalView '处理完成，恢复到普通视图
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True '打开警告提示
End Sub

复制代码

		自动登录	找回密码
密码			免费注册

[求助] 一个困扰我N的问题------合并单元格如何完美跨页打印

最新热点 /1