VBAの勉強を始めてみた

色々試しています。

EXCEL表をTableタグ(HTML)に変換する 其の弐

前回、エクセルの表をHTML(Tableダグ)に変換するという勉強をしましたが、あとから文字の水平位置くらいは指定できたほうがいいんじゃね?と思ったので、今回は前回のコードを改良し、見出し以外の文字の水平位置を指定できるようにしました。

 

前回の記事はこちら

kouten0430.hatenablog.com

 

プラスαで、当ブログを読んでくれる人の中には、エクセルを便利に使いたいけれどもプログラミングには興味が無く「参照設定ってなに?おいしいの?(゜ρ゜) 」という人も少なからずおられると思うので・・・事前に参照設定を行わなくてもマクロを使えるようにしました。(これについては後日、別途記載したいと思います)
となれば過去に掲載した参照設定ありきのマクロを全部修正したくなりましたが、やはり事前に参照設定を済ませておくほうが処理速度としては速いので当面そのままにします。(面倒くさいとも言い換えることができる)

今回のマクロ(末尾に掲載)を使って出力したHTMLコードを、はてなブログであれば「HTML編集モード」でお好きな位置にペーストして下さい。f:id:kouten0430:20171014135517j: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 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 Test Test Test

 

----------------------

Sub 選択範囲をTableタグに変換しクリップボードに出力其の弐()
    '正方形または長方形のような連続した選択範囲とする
    Dim i As Long
    Dim j As Long
    Dim V As String
    Dim rh As Integer
    Dim ch As Integer
    Dim mi 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)
    mi = Application.InputBox(Prompt:="見出し以外の文字の水平位置を指定できます。" & vbCrLf & _
    "1:中央揃え" & vbCrLf & "2:右寄せ" & vbCrLf & "3:両端揃え" & vbCrLf & "キャンセル:左寄せ(初期値)", Type:=1)
        If TypeName(mi) = "Boolean" Then
            Alg = ""
        ElseIf mi = 1 Then
            Alg = " align=""center"""
        ElseIf mi = 2 Then
            Alg = " align=""right"""
        ElseIf mi = 3 Then
            Alg = " align=""justify"""
        End If
   
    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>を追加
                    V = V & "<tr>" & vbCrLf & "<th>" & 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>を追加
                    V = V & "<th>" & Cells(i, j).Value & "</th>" & vbCrLf & "</tr>" & vbCrLf
                Else    '左端と右端以外の処理
                    V = V & "<th>" & Cells(i, j).Value & "</th>"
                End If
            Else '見出し行以外の処理
                If j = Selection.Column Then    '選択範囲の左端であれば冒頭に<tr>を追加
                    If ch = 6 Then  '見出し列の処理。データを<th></th>で囲む
                        V = V & "<tr>" & vbCrLf & "<th>" & Cells(i, j).Value & "</th>"
                    Else    '見出し列以外の処理。データを<td></td>で囲む
                        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>を追加
                    V = V & "<td" & Alg & ">" & Cells(i, j).Value & "</td>" & vbCrLf & "</tr>" & vbCrLf
                Else    '左端と右端以外の処理
                    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までをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら

(2017.11.2 若干のバグ修正)