'*************************************************
'罫線を整える
'*************************************************
'挿入列の１セル毎に罫線をコピーする
Call CopyVerticalBorder(objRange.EntireRow, objNewRow)
Call CopyBottomBorder(objRange.EntireRow, objNewRow)
Call MergeRows(objRange.EntireRow, objNewRow)

'*************************************************
'分割を繰返す
'*************************************************
'分割数だけ、行を挿入する
For i = 3 To lngSplitCount
Call objNewRow.EntireRow.Insert
Next i

'*************************************************
'高さの整備
'*************************************************
'新しい高さに設定
If blnCheckInsert = False Then
If lngSplitCount = 2 Then
objRange.EntireRow.RowHeight = PixelToHeight(Int(lngPixel / 2 + 0.5))
objNewRow.EntireRow.RowHeight = PixelToHeight(Int(lngPixel / 2))
Else
With Range(objRange, objNewRow).EntireRow
If lngPixel < lngSplitCount Then
.RowHeight = PixelToHeight(1)
Else
.RowHeight = PixelToHeight(lngPixel / lngSplitCount)
End If
End With
End If
End If

'境界線を消す
With Range(objRange, objRange(lngSplitCount, 1)).EntireRow
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
'*************************************************
'後処理
'*************************************************
Call Range(objRange, objRange(lngSplitCount, 1)).Select
If blnCheckInsert = False Then
Call ResetPlacement
End If
Call SetOnUndo

If blnDisplayPageBreaks = True Then
ActiveSheet.DisplayAutomaticPageBreaks = True
End If
Application.ScreenUpdating = True
Exit Sub

返信する