スタッフブログ

Set wks = Sheets(“テンプレート”)

xMax = 42
yMax = 40

‘テンプレートの列幅を取得
For lngCol = 1 To xMax
 ReDim Preserve varColWidth(0 To UBound(varColWidth) + 1) As Variant
 varColWidth(UBound(varColWidth)) = wks.Columns(lngCol).ColumnWidth
Next lngCol

‘テンプレートの行高さを取得
For lngRow = 1 To yMax
 ReDim Preserve varRowHeight(0 To UBound(varRowHeight) + 1) As Variant
 varRowHeight(UBound(varRowHeight)) = wks.Rows(lngRow).RowHeight
Next lngRow

‘テンプレートシートより、マージされた各セルのRangeオブジェクトを配列に格納
ReDim objTemplateInfo(0) As Range
strMergeAddress = “”

For lngRow = 1 To yMax

 For lngCol = 1 To xMax

  If wks.Cells(lngRow, lngCol).MergeArea.Address strMergeAddress Then

   Set rng = wks.Range(wks.Cells(lngRow, lngCol).MergeArea.Address)
   ReDim Preserve objTemplateInfo(0 To UBound(objTemplateInfo) + 1) As Range
   Set objTemplateInfo(UBound(objTemplateInfo)) = rng

  End If

  ’次の列のMergeArea.Addressを取得
  strMergeAddress = wks.Cells(lngRow, lngCol).MergeArea.Address

 Next lngCol

Next lngRow

Set wks = Nothing

‘新規シートの追加
Sheets.Add After:=Sheets(Sheets.Count)
Set wks = Sheets(Sheets.Count)

‘列幅の設定
For lngCol = 1 To UBound(varColWidth)
 wks.Columns(lngCol).ColumnWidth = varColWidth(lngCol)
Next n

‘行高さ設定
For lngRow = 1 To UBound(varRowHeight)
 wks.Rows(lngRow).RowHeight = varRowHeight(lngRow)
Next n

‘テンプレートシートから読み込んだ各マージセル情報を新規シートに適用
For n = 1 To UBound(objTemplateInfo)

 ’マージ対象セルのアドレスを取得
 strMergeAddress = objTemplateInfo(n).Address

 ’マージ実行
 wks.Range(strMergeAddress).Merge
 Set rng = wks.Range(strMergeAddress)

 ’マージセルのプロパティ設定
 With objTemplateInfo(n)
  rng.HorizontalAlignment = .HorizontalAlignment
  rng.VerticalAlignment = .VerticalAlignment
  rng.Value = .Value
  rng.ShrinkToFit = .ShrinkToFit
  rng.Interior.Color = .Interior.Color
  rng.Font.Name = .Font.Name
  rng.Font.Size = .Font.Size
  rng.Font.Color = .Font.Color
  rng.Font.Bold = .Font.Bold
  rng.Font.Italic = .Font.Italic
  If .Borders(xlEdgeLeft).LineStyle <> xlNone Then
   rng.Borders(xlEdgeLeft).LineStyle = .Borders(xlEdgeLeft).LineStyle
   rng.Borders(xlEdgeLeft).Color = .Borders(xlEdgeLeft).Color
   rng.Borders(xlEdgeLeft).Weight = .Borders(xlEdgeLeft).Weight
  End If
  If .Borders(xlEdgeTop).LineStyle <> xlNone Then
   rng.Borders(xlEdgeTop).LineStyle = .Borders(xlEdgeTop).LineStyle
   rng.Borders(xlEdgeTop).Color = .Borders(xlEdgeTop).Color
   rng.Borders(xlEdgeTop).Weight = .Borders(xlEdgeTop).Weight
  End If
  If .Borders(xlEdgeRight).LineStyle <> xlNone Then
   rng.Borders(xlEdgeRight).LineStyle = .Borders(xlEdgeRight).LineStyle
   rng.Borders(xlEdgeRight).Color = .Borders(xlEdgeRight).Color
   rng.Borders(xlEdgeRight).Weight = .Borders(xlEdgeRight).Weight
  End If
  If .Borders(xlEdgeBottom).LineStyle <> xlNone Then
   rng.Borders(xlEdgeBottom).LineStyle = .Borders(xlEdgeBottom).LineStyle
   rng.Borders(xlEdgeBottom).Color = .Borders(xlEdgeBottom).Color
   rng.Borders(xlEdgeBottom).Weight = .Borders(xlEdgeBottom).Weight
  End If
 End With

Next n

Set wks = Nothing