はじめに
viz.jsが好きです。Excelマクロ(VBA)も好きです。これらがコラボできれば最高なんじゃないでしょうか！
ということで、やってみます。
[Excel]→[VBA]経由→[viz.js]
データまとめは、ExcelがGoodです。
一方、viz.jsは、データの繋がりを可視化してしてくれますが、データ形式はDOT言語です。
DOT言語の作成はめんどくさい。
すなわち、データをExcelで作っておいて、VBAでDOT言語へ自動変換できれば、いつでもviz.jsの可視化が出来て最高に違いない！
役割分担
- Excel → データ庫
- VBA → データ変換 (データのDOT言語化＋JavaScript込みHTMLファイル作成)
- viz.js → 可視化図作成
作業手順
- 下準備 vis.js (v1.8.2版) をダウンロードしてデスクトップに置く
- 作成作業 Excelの親子情報をマウス選択
- マクロ[VBA]起動
- 自動作業：[HTML & JavaScript 作成]
- 自動作業：[マウス選択された情報をDOT言語構文にして、JavaScriptに組込]
- 自動作業：[HTMLファイルをデスクトップに保存]
- 終
VBAコード
なにはともあれVBAコードです。vis.js（v1.8.2）はデスクトップに置いといてください。
Option Explicit
Sub 子の名前→子の番号→子の件名→子の日付→親子の変更点→親の名前→親の番号()
Dim i, j, oColumn, oRow, oWidth, oHight As Integer
Dim setdata, setdata_R, setdata_name, setdata_day, setdata_change, setdata_Parents, setdata_Parents_R, sheet_name As String
'------------------------------------------------------------------
'選択したセルの背景色をRGB(#RRGGBB)形式で取得する
Dim setdata_bgcolor As String
Dim myR As Long
Dim myG As Long
Dim myB As Long
Dim myColor As Long
Dim setdata_color_Font As String
Dim myR_Font As Long
Dim myG_Font As Long
Dim myB_Font As Long
Dim myColor_Font As Long
'------------------------------------------------------------------
sheet_name = ActiveSheet.Name
Dim htmlfile As String
htmlfile = Environ("HOMEDRIVE") & Environ("HOMEPATH") & "\Desktop" & "\変遷_" & sheet_name & "_" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日.html"
oColumn = Selection.Column
oRow = Selection.Row
oWidth = Selection.Columns.Count
oHight = Selection.Rows.Count
'――――――――――――――――――――――――――――――――――――――
Application.ScreenUpdating = False '非可視化
If oWidth = 7 Then
If oHight < 1000 Then
'――――――――――――――――――――――――――――――――――――――
Open htmlfile For Output As #1
Print #1, "<!DOCTYPE html><html><head><meta charset=""shift-jis""><title>「" & sheet_name & "」変遷</title><script src=""./viz.js""></script></head>"
Print #1, "<body><h1>「" & sheet_name & "」変遷</h1>"
Print #1, "<script>"
Print #1, "document.body.innerHTML += Viz('digraph {node [shape = box,height = 0.3,width = 1.2,Layout = twopi,fontsize=9,target=""_blank""];'+'graph[margin = 0.1,nodesep = 0.5,ranksep = 1.1]'+"
'――――――――――――――――――――――――――――――――――――――
For i = 0 To 0
For j = 0 To oHight - 1
If (Rows(j + oRow).RowHeight <> 0) Then
myColor = Cells(j + oRow, i + oColumn).Interior.Color
myR = myColor Mod 256
myG = Int(myColor / 256) Mod 256
myB = Int(myColor / 256 / 256)
setdata_bgcolor = "#" & Right("0" & Hex(myR), 2) & Right("0" & Hex(myG), 2) & Right("0" & Hex(myB), 2)
myColor_Font = Cells(j + oRow, i + oColumn).Font.Color
myR_Font = myColor_Font Mod 256
myG_Font = Int(myColor_Font / 256) Mod 256
myB_Font = Int(myColor_Font / 256 / 256)
setdata_color_Font = "#" & Right("0" & Hex(myR_Font), 2) & Right("0" & Hex(myG_Font), 2) & Right("0" & Hex(myB_Font), 2)
setdata = CStr(Cells(j + oRow, i + 0 + oColumn)) 'CStrでString型に変換 子の図番（技連番号）
setdata_R = CStr(Cells(j + oRow, i + 1 + oColumn)) 'CStrでString型に変換 子図書R
If i = 0 Then
setdata_name = CStr(Cells(j + oRow, i + 2 + oColumn)) 'CStrでString型に変換 名称
End If
If setdata <> "" Then
setdata = Replace(setdata, Chr(10), "\n")
setdata_name = Replace(setdata_name, Chr(10), "\n")
If i = 0 Then
If Cells(j + oRow, i + 0 + oColumn).Hyperlinks.Count > 0 Then
Print #1, "'""" & setdata & " " & setdata_R & """[label=""" & setdata & " " & setdata_R & "\n" & setdata_name _
& """ href=""" & Cells(j + oRow, i + 0 + oColumn).Hyperlinks(1).Address & """ fontcolor = """ & setdata_color_Font _
& """,style=filled,fillcolor=""" & setdata_bgcolor & """];'+"
Else
Print #1, "'""" & setdata & " " & setdata_R & """[label=""" & setdata & " " & setdata_R & "\n" & setdata_name _
& """ fontcolor = """ & setdata_color_Font _
& """,style=filled,fillcolor=""" & setdata_bgcolor & """];'+"
End If
End If
End If
End If
Next j
Next i
For i = 0 To 0
For j = 0 To oHight - 1
If (Rows(j + oRow).RowHeight <> 0) Then
setdata = CStr(Cells(j + oRow, i + 0 + oColumn))
setdata_R = CStr(Cells(j + oRow, i + 1 + oColumn))
setdata_day = CStr(Cells(j + oRow, i + 3 + oColumn))
setdata_change = CStr(Cells(j + oRow, i + 4 + oColumn))
setdata_Parents = CStr(Cells(j + oRow, i + 5 + oColumn))
setdata_Parents_R = CStr(Cells(j + oRow, i + 6 + oColumn))
If setdata <> "" Then
If setdata_Parents <> "" Then
setdata = Replace(setdata, Chr(10), "\n")'セル内の改行を\n化 vbLf xlPart
setdata_day = Replace(setdata_day, Chr(10), "\n")
setdata_change = Replace(setdata_change, Chr(10), "\n")
setdata_Parents = Replace(setdata_Parents, Chr(10), "\n")
Print #1, "'""" & setdata_Parents & " " & setdata_Parents_R & """->""" & setdata & " " & setdata_R & """[fontsize=8 headlabel=""" & setdata_day & """,label=""" & setdata_change & """];'+"
Print #1, "'""" & setdata & " " & setdata_R & """[group= """ & setdata & """];'+" 'グループ化
End If
End If
End If
Next j
Next i
Print #1, "'}');"
Print #1, "</script></body></html>"
Close #1
Application.ScreenUpdating = True
MsgBox "デスクトップに保存しました。" & Chr(10) & Chr(10) & htmlfile
CreateObject("Wscript.Shell").Run htmlfile, 5
Else
MsgBox "縦は1000行まで"
End If
Else
MsgBox "★横方向に7列を選択して下さい" & vbCr & vbCr & ""
End If
End Sub
サンプルデータとサンプル図
サンプルデータ
| 子の名前 | 子の番号 | 子の件名 | 子の日付 | 親子の変更点 | 親の名前 | 親の番号 |
| 大正 | 明治 | |||||
| 昭和 | 大正 | |||||
| 平成 | 昭和 | |||||
| 令和 | 2019/05/01 | 平成 |
サンプル図
VBAコードの説明
- データ形式は、以下の順番の横７列です。
- 「①子の名前→②子の番号→③子の件名→④子の日付→⑤親子の変更点→⑥親の名前→⑦親の番号」
- ①のセル情報（着色、ハイパーリンク、改行）は、図に反映できます。
- ①の「子の名前」が一緒ならば、グループ化してます
- 出力するHTMLファイルは「shift-JIS」です。
リンク
参考にした記事
Graphvizとdot言語でグラフを描く方法のまとめ
GitHub:Viz.js→v1.8.2版（こちらを利用）
GitHub:Viz.js→v2.1.2版（最新ですが未使用）