午後わてんのブログ

ベランダ菜園とWindows用アプリ作成(WPFとC#)

複数行のセルの値をまとめて1つのテキストボックスにするマクロその2

 
前回の
複数行のセルの値をまとめて1つのテキストボックスにするマクロ ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14674215.html
つづき
 
イメージ 2
選択セル範囲の左の1列をまとめて1つのテキストボックスにする
行ごとのフォントとフォントサイズと
文字ごとの色に対応した
前回と違うのは
  • 行ごとのフォントとフォントサイズに対応
  • 文字ごとの色に対応
  • 背景色は左上のセルと同じにするようにした、塗りつぶしなしやグラデーションの場合は白背景になる
  • テキストボックスのサイズとプロパティのオブジェクトの位置関係はセルに合わせて移動もサイズ変更もしないに変更した
 
 
今回のマクロ
AddTextBoxFromCellsValue3を実行するとテキストボックスを作成する
Sub AddTextBoxFromCellsValue3()
  '選択されているのがセル以外なら何もしないで終了
    If TypeName(Selection) <> "Range" Then Exit Sub
    
    Dim myCells As Range: Set myCells = Selection
     '左端の一列
    Set myCells = myCells.Resize(myCells.Rows.Count, 1)
    Dim tlCell As Range
    Set tlCell = myCells.Cells(1) '左上のセル
    
     'テキストボックスに表示する文字列を作成
    Dim str As String: str = tlCell.text
    Dim i As Integer
    For i = 2 To myCells.Cells.Count
        str = str & vbNewLine & myCells.Cells(i).text
    Next
        
    'テキストボックス作成
    Dim myTB As Shape
    Set myTB = ActiveSheet.Shapes.AddTextbox( _
                msoTextOrientationHorizontal, _
                tlCell.Left, tlCell.Top, 100, 10)
    With myTB
        .TextFrame.AutoSize = True 'オートサイズを有効にする
'        .Placement = xlMove 'セルに合わせて移動するけどサイズ変更しない
       .Placement = xlFreeFloating '移動もサイズ変更もしない

        '背景色設定、左上のセルの色が単色ならその色にする
        If tlCell.Interior.ColorIndex <> xlColorIndexAutomatic And _
            tlCell.Interior.ColorIndex <> xlColorIndexNone Then
            .Fill.ForeColor.Rgb = tlCell.Interior.Color
        End If
        '文字の設定
        With .TextFrame2.TextRange
            .text = str '文字列指定
            For i = 1 To .Paragraphs.Count
                'フォントカラーの指定
                Call SetFontColor(.Paragraphs(i), myCells(i))
                'フォントの指定
                Call SetFontToParagraph(.Paragraphs(i), myCells(i))
            Next
        End With
    End With
End Sub

'Paragraphのフォントカラーをセルのフォントカラーに合わせる
Sub SetFontColor(p As TextRange2, r As Range)
    'セルのフォントカラーがNullなら複数の色が指定されているので
    '1文字ごとに色指定する
    If IsNull(r.Font.Color) Then
        For i = 1 To p.Characters.Count
            p.Characters(i, 1).Font.Fill.ForeColor.Rgb _
                = r.Characters(i, 1).Font.Color
        Next
    Else
        p.Font.Fill.ForeColor.Rgb = r.Font.Color
    End If
End Sub

'Paragraphのフォントをセルのフォントに合わせる
Sub SetFontToParagraph(p As TextRange2, r As Range)
    Dim f As Font: Set f = r.Font
    With p.Font
        .Name = f.Name
        .NameFarEast = f.Name
        .Size = f.Size
    End With
End Sub
 
 
 
'背景色設定、左上のセルの色が単色ならその色にする
        If tlCell.Interior.ColorIndex <> xlColorIndexAutomatic And _
            tlCell.Interior.ColorIndex <> xlColorIndexNone Then
            .Fill.ForeColor.Rgb = tlCell.Interior.Color
        End If
テキストボックスの背景色にする色は左上のセルの塗りつぶしの色に合わせる
このとき塗りつぶしの色が単色ならそのままでいいから
            テキストボックス.Fill.ForeColor.Rgb = セル.Interior.Color
これでOK
塗りつぶしなしやグラデーションだった場合は白にしたい
この判定はセル.Interior.ColorIndexの値を見て判定した
塗りつぶしなしのときは
xlColorIndexAutomatic
グラデーションのときは
xlColorIndexNone
なのでどちらかだったときは背景色無指定(白背景)
 
 
 
 
テキストボックスの中の文字列は1行ごとにParagraphっていうプロパティ?になっている、型はTextRange2
 
 
イメージ 1
この場合だとParagraphが4つ
取得は
Dim ps as TextRange2
Set ps = Shape.TextFrame2.TextRange.Paragraphs

これで4行全部取得できて
この中の1行目取得なら
 
Dim p as TextRange2
Set p = ps(1)
 
 
Paragraphのフォントカラーの指定
1行目全部を白にするなら
p.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
 
3文字目だけを白にするならCharactersを使って
p.Characters(3, 1).Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
 
今回は使わないけど
2文字目から4文字分(2~5文字目)を白にするなら
p.Characters(2, 4).Font.Fill.ForeColor.RGB = RGB(255, 255, 255)


セルの文字色取得
全部同じ色なのか2色以上あるのかの判定
2色以上あるときはRange.Font.Colorの値がNullになっているので
If IsNull(Range.Font.Color) Then
こんな感じでIsNullを使って判定できる
 
全部同じ色なら
p.Font.Fill.ForeColor.RGB = Range.Font.Color
これでOK
 
2色以上のときは1文字ごとに色を取得、設定するので
これもCharactersを使って
2文字目の色指定なら
p.Characters(2, 1).Font.Fill.ForeColor.Rgb _
= Range.Characters(2, 1).Font.Color
 
 
 
 
イメージ 4
1文字ごとに色指定の処理をステップ実行しているところ
 
ヤフーブログに直接載せられるアニメーションGIFは横幅560ピクセル以下なのかも、712x632のものを載せようとしたら以下のメッセージ
イメージ 3
もしかして縮小表示ができないだけかも、ってことで縮小表示にならないように右側を削って幅560ピクセルにしたらうまく載せられた
 
 
次回(関連記事)
図形のテキストボックスのタブ文字、タブ位置とかのメモ、選択セル範囲を1つのテキストボックスにするマクロ ( ソフトウェア ) - 午後わてんのブログ - Yahoo!ブログ
http://blogs.yahoo.co.jp/gogowaten/14686706.html