'參考論壇里的資料 ，自己改了一下
Sub 跨頁的合并單元格區(qū)域拆分以便打印()
Dim 標(biāo)題, 選項
標(biāo)題 = "跨頁的合并單元格區(qū)域拆分以便打印,需要先設(shè)置一下打印區(qū)域"
選項 = MsgBox(" 是 : 已經(jīng)按部分合并單元格局部調(diào)整分頁符位置" & Chr(10) & " 否 : 在復(fù)制工作表上操作" & Chr(10) & "取消:退出并手動調(diào)整部分分頁符位置 ", 3, 標(biāo)題)
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 '打開分頁預(yù)覽，這樣會出現(xiàn)分頁符
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 '打開分頁預(yù)覽，這樣會出現(xiàn)分頁符
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 '當(dāng)大于一頁時執(zhí)行代碼
For Nr = 1 To .HPageBreaks.Count '循環(huán)列舉各個水平分頁符位置
R = .HPageBreaks(Nr).Location.Row '取得當(dāng)前列舉到的水平分布所在的行的值
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 '選中當(dāng)前行的第一列的單元格
My_str = .Cells(1, 1).Value
My_str_1 = Split(.Address, "")
My_str_2(2) = I & ":"
Set A1 = Range(Join(My_str_1, ""))
邊框線型 = .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 '處理完成，恢復(fù)到普通視圖
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True '打開警告提示
End Sub
復(fù)制代碼