VBAの勉強を始めてみた

色々試しています。

EXCEL表をTableタグに変換する 其の参(文字の水平位置を反映する)

先日、ブログのデザインテーマを「Bordeaux」から「Natural」へ変更した際、「Bordeaux」ではデフォルトでTableの見出しの文字が中央揃えだったのに対し、「Natural」では見出しも含めてすべて左揃えとなってしまい、過去記事が意図しないレイアウトになってしまいました(注意して見ないと分からないレベルですが)。なので、デザインテーマによってTable内の文字位置が変わってしまわないように、見出しも含めてインラインで固定してしまおう!と思ったのが今回の記事のきっかけです。
「其の弐」からの変更点は、文字の水平位置は、セルごとの位置をそのままTableに反映するという点です。水平位置が指定されていないセルは「指定無し」をそのまま反映します。その場合、文字の水平位置はブログテーマのCSSに従います。

下のような表を今回のマクロでTableに変換し

f:id:kouten0430:20180217104237j:plain

 

ブログに貼り付けるとこんな感じです。

Test Test Test Test
Test Test Test Test
Test Test Test Test
Test Test Test Test
Test Test Test Test
Test Test Test Test
Test Test Test Test
Test Test Test Test
Test Test Test Test

 

マクロに実装している機能と、していない機能、その理由をまとめると次のとおりです。

 

以下はブログテーマのCSSで自動的に指定されるのでマクロに実装していません。

  • Tableの罫線
  • 見出しの背景色

 

以下は「見たまま編集」モードで変更できるのでマクロに実装していません。

  • 文字の大きさ
  • 文字の色
  • 文字の太さ
  • Tableの枠幅

 

以下は「見たまま編集」モードで変更できないのでマクロに実装しています。

  • 見出しの有り、無し
  • 文字の水平位置(今回の変更点)

 

以下は「見たまま編集」モードで変更できないが、個人的に需要がないのでマクロに実装していません。

  • 文字の垂直位置
  • 見出し以外の背景色

 

以下は、コードを思いついていないため実装していません。(笑)

  • 結合セルの反映

 

はてな以外のブログサービスのCSSや編集モードの詳細は分からないので、とりあえず、はてなブログ用に最低限の機能をもったものという位置付けです。

マクロの使い方

  1. Excel上でTableタグに変換したい範囲を選択し、マクロを実行
  2. 見出しの有無を指定
  3. クリップボードにTableタグが格納されるので、はてなブログの「HTML編集」モードで、好きな位置にペーストする
Sub 選択範囲をTableタグに変換しクリップボードに出力其の参()
    '正方形または長方形のような連続した選択範囲とする
    'セルの内容の水平位置を再現します(左、右、中央のみ)。水平位置が無指定なら無指定であることを再現します。
    Dim i As Long
    Dim j As Long
    Dim V As String
    Dim rh As Integer
    Dim ch As Integer
    Dim ha As Integer
    Dim Alg As String
    Dim myLib As Object
    Set myLib = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")  '参照設定なしでDataObjectのインスタンスを生成する
    
    rh = MsgBox("選択範囲の上端の行を" & vbCrLf & "見出しにしますか?", vbYesNo)
    ch = MsgBox("選択範囲の左端の列を" & vbCrLf & "見出しにしますか?", vbYesNo)
    
    V = "<table>" & vbCrLf

    For i = Selection.Row To Selection.Rows(Selection.Rows.Count).Row
        For j = Selection.Column To Selection.Columns(Selection.Columns.Count).Column
            If i = Selection.Row And rh = 6 Then '見出し行の処理。データを<th></th>で囲む
                If j = Selection.Column Then    '選択範囲の左端であれば冒頭に<tr>を追加
                    ha = Cells(i, j).HorizontalAlignment    'データの水平位置を取得する
                        If ha = -4131 Then
                            Alg = " align=""left"""
                        ElseIf ha = -4152 Then
                            Alg = " align=""right"""
                        ElseIf ha = -4108 Then
                            Alg = " align=""center"""
                        Else
                            Alg = ""
                        End If
                    V = V & "<tr>" & vbCrLf & "<th" & Alg & ">" & Cells(i, j).Value & "</th>"
                        If j = Selection.Columns(Selection.Columns.Count).Column Then     '左端かつ右端である場合の処置
                            V = V & vbCrLf & "</tr>" & vbCrLf
                        End If
                ElseIf j = Selection.Columns(Selection.Columns.Count).Column Then   '選択範囲の右端であれば末尾に</tr>を追加
                    ha = Cells(i, j).HorizontalAlignment    'データの水平位置を取得する
                        If ha = -4131 Then
                            Alg = " align=""left"""
                        ElseIf ha = -4152 Then
                            Alg = " align=""right"""
                        ElseIf ha = -4108 Then
                            Alg = " align=""center"""
                        Else
                            Alg = ""
                        End If
                    V = V & "<th" & Alg & ">" & Cells(i, j).Value & "</th>" & vbCrLf & "</tr>" & vbCrLf
                Else    '左端と右端以外の処理
                    ha = Cells(i, j).HorizontalAlignment    'データの水平位置を取得する
                        If ha = -4131 Then
                            Alg = " align=""left"""
                        ElseIf ha = -4152 Then
                            Alg = " align=""right"""
                        ElseIf ha = -4108 Then
                            Alg = " align=""center"""
                        Else
                            Alg = ""
                        End If
                    V = V & "<th" & Alg & ">" & Cells(i, j).Value & "</th>"
                End If
            Else '見出し行以外の処理
                If j = Selection.Column Then    '選択範囲の左端であれば冒頭に<tr>を追加
                    If ch = 6 Then  '見出し列の処理。データを<th></th>で囲む
                        ha = Cells(i, j).HorizontalAlignment    'データの水平位置を取得する
                            If ha = -4131 Then
                                Alg = " align=""left"""
                            ElseIf ha = -4152 Then
                                Alg = " align=""right"""
                            ElseIf ha = -4108 Then
                                Alg = " align=""center"""
                            Else
                                Alg = ""
                            End If
                        V = V & "<tr>" & vbCrLf & "<th" & Alg & ">" & Cells(i, j).Value & "</th>"
                    Else    '見出し列以外の処理。データを<td></td>で囲む
                        ha = Cells(i, j).HorizontalAlignment    'データの水平位置を取得する
                            If ha = -4131 Then
                                Alg = " align=""left"""
                            ElseIf ha = -4152 Then
                                Alg = " align=""right"""
                            ElseIf ha = -4108 Then
                                Alg = " align=""center"""
                            Else
                                Alg = ""
                            End If
                        V = V & "<tr>" & vbCrLf & "<td" & Alg & ">" & Cells(i, j).Value & "</td>"
                    End If
                        If j = Selection.Columns(Selection.Columns.Count).Column Then     '左端かつ右端である場合の処置
                            V = V & vbCrLf & "</tr>" & vbCrLf
                        End If
                ElseIf j = Selection.Columns(Selection.Columns.Count).Column Then   '選択範囲の右端であれば末尾に</tr>を追加
                    ha = Cells(i, j).HorizontalAlignment    'データの水平位置を取得する
                        If ha = -4131 Then
                            Alg = " align=""left"""
                        ElseIf ha = -4152 Then
                            Alg = " align=""right"""
                        ElseIf ha = -4108 Then
                            Alg = " align=""center"""
                        Else
                            Alg = ""
                        End If
                    V = V & "<td" & Alg & ">" & Cells(i, j).Value & "</td>" & vbCrLf & "</tr>" & vbCrLf
                Else    '左端と右端以外の処理
                    ha = Cells(i, j).HorizontalAlignment    'データの水平位置を取得する
                        If ha = -4131 Then
                            Alg = " align=""left"""
                        ElseIf ha = -4152 Then
                            Alg = " align=""right"""
                        ElseIf ha = -4108 Then
                            Alg = " align=""center"""
                        Else
                            Alg = ""
                        End If
                    V = V & "<td" & Alg & ">" & Cells(i, j).Value & "</td>"
                End If
            End If
        Next j
    Next i
    
    V = V & "</table>"
    
    myLib.SetText V  '変数の値をDataObjectに格納する
    myLib.PutInClipboard 'DataObjectのデータをクリップボードに格納する
    
    MsgBox "HTMLをクリップボードに" & vbCrLf & "出力しました!" & vbCrLf & vbCrLf & _
    "ブログなどでお好みの位置にペースト" & vbCrLf & "して下さい。"
    
End Sub

※SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら

 

kouten0430.hatenablog.com

 

 

kouten0430.hatenablog.com