VISIOでCE図（特性要因図）作成

VISIOでCE図（特性要因図）作成

2005/07/30 ほんだ

Last Modified:2020/08/12

CE図（特性要因図）はＱＣ７つ道具の１つで、原因分析に利用されることが多い。図示することで分かりやすいが、逆に作図が少し面倒。

原因分析に時間を割きたい（割くべきである）との個人的な思いから、VISIO（マイクロソフトのグラフィックソフト）で作図するソフトを作成した。具体的には、VISIOのマクロ（＝VBA）。マクロの起動で、特定のCSVファイルを読み込み、VISIOで描画する。

参考にしてもらう意図で公開する。特に統計処理ソフト”Ｒ”での作画のチャレンジなどに役立ててもらえれば幸いである。

なお、あくまで参考にとの考えなので、バグの連絡や要望を受けたとしても対処できない。当然ながら、著作権は「ほんだ」に帰属。また、本マクロの利用での不具合があったとしてもなんら対応するものではないので、よろしく。（誤字脱字の類があったり他にエレガントな方法があるかも知れないが、短い時間での作成だったこともあるのでご勘弁。）

環境的には、VISIO2003 Pro、WindowsXP Proで動作確認した。

例のCSVファイルやマクロのソースを見てもらえば分かるが、カンマでより深い要因レベルの文言を記述する。行頭の”#”はコメントとして扱う。（1行に1要因のみの記述としているので、有効な要因の文字列以降もコメントとして利用は可能。）

・VISIOマクロのソース。
（以下のテキストファイルをVISIOのマクロのペースト。マクロ名は特に固定ではない（ないはず）。）

'特性要因図（CE図）を作成する、VISIOマクロ　VBA。
'本マクロを含むVISIOファイルと同じフォルダに、以下ファイル"Sample_CE_Diagram.csv"に要因図の
ための情報を記載する。
'要因図のための情報は、CSVでいくつかの”,"の後に要因の文字列を記載する。（","の数が要因のレ
ベルをあらわすことになる。）
'本VISIOファイルでの1番目のページに結果を表示する。なお本マクロ実行の際にそのページに描画デ
ータがないとエラーとなるので、直線など仮の図形を描いておくこと。
'他にもバグとかあると思うし、もう少しエレガントに出来ると思いますが、、、、。（バグの連絡も
らっても直さないと思う、、、。）
'特にフリーの統計ソフト”R"での特性要因図（CE図）作成に誰かチャレンジして～～
'
'Copyright (c) 2005 Kazuyuki Honda All rights reserved.
'
Public Const STRCSVFILENAME As String = "Sample_CE_Diagram.csv"

Public Const IMAX_LEVEL As Integer = 8 '要因の深さ　最終的には8

Public Const IMAXNUMBER_LINE_XY As Integer = 100 '100点（直線の開始点、終了点の
情報。）=CSVファイルでの最大行数（コメント以外）　 VISIO=紙面空間 別配列で要因テキスト列
Public DLineStartXY(1 To IMAXNUMBER_LINE_XY, 1 To 2)
Public DLineEndXY(1 To IMAXNUMBER_LINE_XY, 1 To 2)
Public DStrFactorXY(1 To IMAXNUMBER_LINE_XY, 1 To 2) '要因文字列のXY(中心位置)
Public StrFactor(1 To IMAXNUMBER_LINE_XY) As String '要因の文字列そのもの
Public IFactorLevel_Line(1 To IMAXNUMBER_LINE_XY) As Integer '要因のレベル　０～　（
未入力で-1）

Public IIndexSameLevel(1 To IMAXNUMBER_LINE_XY) As Integer '処理中レベルの要因の配
列上のIndex　０～

Public Const DRATELINE_LEVEL0TOPAPER As Double = 0.8 '要因レベル0の直線
の紙面に対する比率
Public Const DRATELINE_PREVIOUSLEVEL As Double = 0.4 '要因レベルNの直線
のレベル（N-1)に対する比率

Public Const DRATELINE_LEVEL1_FORPAPERRATE As Double = 0.6 '要因レベル1の紙の
幅高比率に対する、更にその比率。1で紙比率と同じ。1以下でより短く

Public Const DMINLINE_PREVIOUSLEVEL As Double = 9 '想定する最小のN-1の
長さ　（余り小さくなると見えなくなるので）
Public Const DMINLINE_LEVEL_SETPREVIOUS As Double = 5 '想定する最小のN-1の
長さ以下の時の強制設定値

Public Const DRATEX_FORODD_FACTOR As Double = 0.5 '1（奇数）要因のX長
比率　一応定数化 60度なので　√3
Public Const DRATEX_FOREVEN_FACTOR As Double = 1.732050808 / 2 '2（偶数）要因でのX
長比率　一応定数化 60度　√3/2

Public Const STRCONST_ARROWTYPE As String = "4"
Public Const STRCONST_ARROWSIZE As String = "0.5"

Public Const STRCONST_LINEWIDTH_FORLEVEL0 As String = "0.05" '線の太さ　単位ポイ
ント
Public Const STRCONST_LINEWIDTH_FORLEVEL1 As String = "0.03"
Public Const STRCONST_LINEWIDTH_FORLEVELOTHERS As String = "0.015"

'要因文字列のフォントサイズ
Public Const ITEXTSIZE_LEVEL0_POINT As Integer = 24
Public Const ITEXTSIZE_POINT As Integer = 8

Public Const DMILI2INCH_DIV As Double = 25.4

Public Const I_PAGENUMBER As Integer = 1

Public Const DCONST_TEXTWIDTH_DIVE2 As Double = 20 / 2 '要因文
字列の幅の半分　mm　注意；レベル0の時は、縦書きにして、幅と高を逆転させる
Public Const DCONST_TEXTWIDTH_DIVE2_INCH As Double = (20 / 2) / DMILI2INCH_DIV '要因文
字列の幅の半分　インチ　注意；レベル0の時は、縦書きにして、幅と高を逆転させる
Public Const DCONST_TEXTHEIGHT_DIVE2 As Double = 10 / 2 '要因文
字列の幅　mm
Public Const DCONST_TEXTHEIGHT_DIVE2_INCH As Double = (10 / 2) / DMILI2INCH_DIV '要因文
字列の幅　インチ
Public Const DCONST_LEVEL0_TEXTHEIGHT_INCH As Double = (60 / 2) / DMILI2INCH_DIV 'レベル
0　要因文字列の高の半分　インチ
Public Const DCONST_LEVEL0_TEXTWIDTH_INCH As Double = (10 / 2) / DMILI2INCH_DIV 'レベル
0　要因文字列の幅の半分　インチ
Public StrText As String '文字列
そのもの

Public BoolFactorIn_level0 As Boolean
Public ITempNumLine As Integer '解析中CSVファイルでの有効直線の個数　１～ (カウン
トアップ）
Public INumLines As Integer '解析中CSVファイルでの有効直線の個数

Public IPreviousLevel As Integer '解析中の直前のレベル（自分と同じレベルの時がある。
）
Public ISerchLevel As Integer '解析中のレベル（配列上のレベル＝有効な文字列の前
の","の個数）
Public INumSameTempLevel As Integer '解析中のレベルと同一レベルの個数　1～　解析中に使
用
Public INumSameLevel As Integer '解析中のレベルと同一レベルの個数　1～
Public IIndexSameTempLevel As Integer '解析中のレベルの先頭の配列上のIndex

Public DPositionX1_AtPaper_Inch As Double '紙上、単位インチ　矩形なら左上
。直線は開始
Public DPositionY1_AtPaper_Inch As Double

Public DPositionX2_AtPaper_Inch As Double '紙上、単位インチ　矩形なら右下
。直線は終了
Public DPositionY2_AtPaper_Inch As Double

Public DPaperHeight As Double
Public DPaperWidth As Double
Public DRatePaperWH As Double

'要因レベル1の更なる比率（レベル1がレベル0に対して極端に短いケースの救済　紙面に納めたいた
め） DRatePaperWHも利用
Public DRateLine_For_Level1 As Double

Public StrLine As String

Public INumComma As Integer
Public BoolFindLevel As Boolean

Public ITemp As Integer
Public ITemp2 As Integer
Public StrTemp As String
Public StrTemp2 As String
Public StrTempFactor As String
Public StrTempFactorFirst As String

Sub CE_Gen()
Dim VisioAppObj As Visio.Application
Dim VisioPage As Visio.Page
Dim VisioSelctionObj As Visio.Selection
Dim VisioShapeObj As Visio.Shape

DPaperWidth = ActiveDocument.PaperWidth(visMillimeters) 'ミリでの取得
DPaperHeight = ActiveDocument.PaperHeight(visMillimeters) 'ミリでの取得

DRatePaperWH = DPaperWidth / DPaperHeight '幅／高の比率　1>で横長
DRateLine_For_Level1 = (1 / DRatePaperWH) * DRATELINE_LEVEL1_FORPAPERRATE

'Application.StatusBar = "" ★VISIO2002から使えないんだって。VISIOのモードレスダイアログを
使えばいいみたいだけど。
'Application.DisplayStatusBar = True 'ステータスバーを有効に
'Application.StatusBar = "す........"

Table_Initial '各種情報の初期化　既存図形のクリア

'
'元のCSVファイルを読み込んで、要因のレベル／文字列をチェック。異常ではメッセージ表示して停
止。
'チェックOKなら、要因のレベルテーブル生成と文字列の配列に文字列をセット。
'その後要因のレベルテーブルから直線生成（実際は直線の開始終了テーブル作成後、一挙に描画）。

Open STRCSVFILENAME For Input As #1

ITempNumLine = 1

BoolFactorIn_level0 = False

Do While Not EOF(1)
Line Input #1, StrLine

StrLine = Trim(StrLine)

If Mid(StrLine, 1, 1) = "#" Or Mid(StrLine, 1, 2) = "//" Or StrLine = "" Then
'コメント文

ElseIf InStr(1, StrLine, ",") = 1 And BoolFactorIn_level0 = False Then
MsgBox ("先頭がレベル0の情報でありません（先頭がコンマ）。終了します。目安の行＝" + Str
(ITempNumLine))
Exit Sub
Else
'文字列を解析し、カンマの数と有効文字列抽出

StrTemp = ""
StrTemp2 = ""
StrTempFactor = ""
StrTempFactorFirst = "" '行での先頭文字列

BoolFactorIn = False
INumComma = 0

For ITemp = 1 To Len(StrLine)
If Mid(StrLine, ITemp, 1) <> "," Then
StrTempFactor = StrTempFactor + Mid(StrLine, ITemp, 1)
Else '=","

If StrTempFactor <> "" And BoolFactorIn = False Then
BoolFactorIn = True
StrTempFactorFirst = StrTempFactor
Exit For '先頭の文字列のみ要因として有効
End If

INumComma = INumComma + 1 '直前のカンマ数がレベルなので、プラス1はここ
End If
Next ITemp

'カンマ無しもありうるのでLoop外で処理
If INumComma > IMAX_LEVEL Then
MsgBox ("レベルが深すぎます（カンマの数が多すぎます）。終了します。目安の行＝" + Str(
ITempNumLine))
Exit Sub
End If

If StrTempFactor <> "" And BoolFactorIn = False Then 'カンマ無しのケースの救済
BoolFactorIn = True
StrTempFactorFirst = StrTempFactor
End If

'整合性の確認
If StrTempFactorFirst = "" Then
MsgBox ("要因の文字列がありません。終了します。目安の行＝" + Str(ITempNumLine))
Exit Sub
End If


'要因文字列とレベル配列設定
StrFactor(ITempNumLine) = StrTempFactorFirst
IFactorLevel_Line(ITempNumLine) = INumComma
If INumComma = 0 Then BoolFactorIn_level0 = True
ITempNumLine = ITempNumLine + 1

End If
Loop

INumLines = ITempNumLine - 1

DoEvents
DoEvents
DoEvents

Close #1

'要因文字列とレベル配列設定から直線座標計算⇒配列へ
For ISerchLevel = 0 To IMAX_LEVEL

BoolFindLevel = False '該当レベルの要因が見つかったか？　該当レベルの先頭の直前はレベルー
1のはず

For ITemp2 = 1 To IMAXNUMBER_LINE_XY 'INumLinesまででいいが念のため
IIndexSameLevel(ITemp2) = 0 '処理しようとするレベルと一致するIndex(有効行の
行)　同一レベルの群毎にセット
Next ITemp2

'レベル0の時は、レベル0が複数ないかのチェックのみ
If ISerchLevel = 0 Then
INumSameTempLevel = 0

For ITemp = 1 To INumLines
If IFactorLevel_Line(ITemp) = -1 Then Exit For
If IFactorLevel_Line(ITemp) = 0 Then INumSameTempLevel = INumSameTempLevel + 1
Next ITemp

If INumSameTempLevel <> 1 Then
MsgBox ("要因レベル0が複数存在します。終了します。")
Exit Sub
End If
Else
'レベル1以上
'同一レベルの群の開始を探す
ISerchLevelLine = 1

Do
If IFactorLevel_Line(ISerchLevelLine) = -1 Or ISerchLevelLine > INumLines Then Exit D
o
If IFactorLevel_Line(ISerchLevelLine) = ISerchLevel Then
INumSameTempLevel = 0 '別の群の時は、ここは0でOK。その時の直前のレベルは－１
でなくてもOK。
IIndexStartSameLevel = ISerchLevelLine

If BoolFindLevel = False And IFactorLevel_Line(IIndexStartSameLevel - 1) <> ISerchL
evel - 1 Then
MsgBox ("直前のレベルがレベル-1でありません。終了します。目安の行＝" + Str(ISerch
LevelLine))
Exit Sub
End If

If BoolFindLevel = False Then
BoolFindLevel = True
IIndexPreviousLevel = IIndexStartSameLevel - 1
End If

'同一レベル群最後の検索 より深いレベルは読みとばし 先頭の行もここで処理
For ITemp2 = IIndexStartSameLevel To INumLines
If IFactorLevel_Line(ITemp2) = -1 Then Exit For
If IFactorLevel_Line(ITemp2) < ISerchLevel Then Exit For
If IFactorLevel_Line(ITemp2) = ISerchLevel Then
INumSameTempLevel = INumSameTempLevel + 1
IIndexSameLevel(INumSameTempLevel) = ITemp2
End If
Next ITemp2

IIndexEndSameLevel = ITemp2 - 1

'★次のサーチに備える
ISerchLevelLine = IIndexEndSameLevel '後で共通的に＋1するので注意　（最終行でOK
）

BoolFindLevel = False '次のサーチに備えクリア

DPreviousLevelStartX = DLineStartXY(IIndexPreviousLevel, 1)
DPreviousLevelStartY = DLineStartXY(IIndexPreviousLevel, 2)
DPreviousLevelEndX = DLineEndXY(IIndexPreviousLevel, 1)
DPreviousLevelEndY = DLineEndXY(IIndexPreviousLevel, 2)

DPreviousLevelLengthWithRate = Sqr((DPreviousLevelEndX - DPreviousLevelStartX) ^ 2
+ (DPreviousLevelEndY - DPreviousLevelStartY) ^ 2) * DRATELINE_PREVIOUSLEVEL

DDeltaX = (DPreviousLevelEndX - DPreviousLevelStartX) / (INumSameTempLevel + 1)
DDeltaY = (DPreviousLevelEndY - DPreviousLevelStartY) / (INumSameTempLevel + 1)


'要因レベル1の時は、レベル0に更に比率
If ISerchLevel = 1 Then DPreviousLevelLengthWithRate = Sqr((DPreviousLevelEndX - DP
reviousLevelStartX) ^ 2 + (DPreviousLevelEndY - DPreviousLevelStartY) ^ 2) * DRateLine_For_
Level1


If DPreviousLevelLengthWithRate <= DMINLINE_PREVIOUSLEVEL Then DPreviousLevelLength
WithRate = DMINLINE_LEVEL_SETPREVIOUS '想定する最小のN-1の長さ以下の時の強制設
定
'同一レベルのX,Y算出
For ITemp2 = 1 To INumSameTempLevel

IIndexTemp_SameLevel = IIndexSameLevel(ITemp2)

DLineEndXY(IIndexTemp_SameLevel, 1) = DPreviousLevelStartX + DDeltaX * ITemp2
DLineEndXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY + DDeltaY * ITemp2

'Mod関数にバグがあるので注意　(ITemp2 Mod 2) <> 2 でも比較
If (ISerchLevel Mod 4) = 1 Then '★レベル０（４、、、）の方向に依存する

If DPreviousLevelStartX < DPreviousLevelEndX Then
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1) -
DPreviousLevelLengthWithRate * DRATEX_FORODD_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel, 1)
'要因文字列のXは開始点と同じへ
If (ITemp2 Mod 2) <> 0 And (ITemp2 Mod 2) <> 2 Then
DLineStartXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY + DPreviousLev
elLengthWithRate * DRATEX_FOREVEN_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel,
2) + DCONST_TEXTHEIGHT_DIVE2
Else
DLineStartXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY - DPreviousLev
elLengthWithRate * DRATEX_FOREVEN_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel,
2) - DCONST_TEXTHEIGHT_DIVE2
End If
Else
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1) +
DPreviousLevelLengthWithRate * DRATEX_FORODD_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel, 1)
'要因文字列のXは開始点と同じへ
If (ITemp2 Mod 2) <> 0 And (ITemp2 Mod 2) <> 2 Then
DLineStartXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY - DPreviousLev
elLengthWithRate * DRATEX_FOREVEN_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel,
2) - DCONST_TEXTHEIGHT_DIVE2
Else
DLineStartXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY + DPreviousLev
elLengthWithRate * DRATEX_FOREVEN_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel,
2) + DCONST_TEXTHEIGHT_DIVE2
End If
End If

ElseIf (ISerchLevel Mod 4) = 2 Then
DLineStartXY(IIndexTemp_SameLevel, 2) = DLineEndXY(IIndexTemp_SameLevel, 2)
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel, 2)
'要因文字列のYは開始点と同じへ
If (ITemp2 Mod 2) <> 0 And (ITemp2 Mod 2) <> 2 Then
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1) +
DPreviousLevelLengthWithRate
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel, 1)
+ DCONST_TEXTWIDTH_DIVE2
Else
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1) -
DPreviousLevelLengthWithRate
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel, 1)
- DCONST_TEXTWIDTH_DIVE2
End If

ElseIf (ISerchLevel Mod 4) = 3 Then '★レベル2(6、、、)の方向に依存する
If DPreviousLevelStartX > DPreviousLevelEndX Then
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1) +
DPreviousLevelLengthWithRate * DRATEX_FORODD_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel, 1)
'要因文字列のXは開始点と同じへ

If (ITemp2 Mod 2) <> 0 And (ITemp2 Mod 2) <> 2 Then
DLineStartXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY - DPreviousLev
elLengthWithRate * DRATEX_FOREVEN_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel,
2) - DCONST_TEXTHEIGHT_DIVE2
Else
DLineStartXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY + DPreviousLev
elLengthWithRate * DRATEX_FOREVEN_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel,
2) + DCONST_TEXTHEIGHT_DIVE2
End If
Else
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1) -
DPreviousLevelLengthWithRate * DRATEX_FORODD_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel, 1)
'要因文字列のXは開始点と同じへ
If (ITemp2 Mod 2) <> 0 And (ITemp2 Mod 2) <> 2 Then
DLineStartXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY + DPreviousLev
elLengthWithRate * DRATEX_FOREVEN_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel,
2) + DCONST_TEXTHEIGHT_DIVE2
Else
DLineStartXY(IIndexTemp_SameLevel, 2) = DPreviousLevelStartY - DPreviousLev
elLengthWithRate * DRATEX_FOREVEN_FACTOR
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel,
2) - DCONST_TEXTHEIGHT_DIVE2
End If
End If

ElseIf ISerchLevel <> 0 Then 'レベル0は処理しない　'★レベル3（７、、、）の
方向に依存する
DLineStartXY(IIndexTemp_SameLevel, 2) = DLineEndXY(IIndexTemp_SameLevel, 2)
DStrFactorXY(IIndexTemp_SameLevel, 2) = DLineStartXY(IIndexTemp_SameLevel, 2)
'要因文字列のYは開始点と同じへ
If DPreviousLevelStartY > DPreviousLevelEndY Then
If (ITemp2 Mod 2) <> 0 And (ITemp2 Mod 2) <> 2 Then
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1)
+ DPreviousLevelLengthWithRate
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel,
1) + DCONST_TEXTWIDTH_DIVE2
Else
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1)
- DPreviousLevelLengthWithRate
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel,
1) - DCONST_TEXTWIDTH_DIVE2
End If
Else
If (ITemp2 Mod 2) <> 0 And (ITemp2 Mod 2) <> 2 Then
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1)
- DPreviousLevelLengthWithRate
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel,
1) - DCONST_TEXTWIDTH_DIVE2
Else
DLineStartXY(IIndexTemp_SameLevel, 1) = DLineEndXY(IIndexTemp_SameLevel, 1)
+ DPreviousLevelLengthWithRate
DStrFactorXY(IIndexTemp_SameLevel, 1) = DLineStartXY(IIndexTemp_SameLevel,
1) + DCONST_TEXTWIDTH_DIVE2
End If
End If

End If

Next ITemp2


End If

'★次のサーチに備える
BoolFindLevel = False '次のサーチに備えクリア

'★次のサーチ
ISerchLevelLine = ISerchLevelLine + 1

Loop '次の同一レベルの群へ

End If

Next ISerchLevel '次のレベルの処理へ

'図形描画そのもの

For ITemp = 1 To INumLines
If IFactorLevel_Line(ITemp) = -1 Then Exit For

DPositionX1_AtPaper_Inch = DLineStartXY(ITemp, 1) / DMILI2INCH_DIV '紙上、単位イン
チ　直線は開始
DPositionY1_AtPaper_Inch = DLineStartXY(ITemp, 2) / DMILI2INCH_DIV
DPositionX2_AtPaper_Inch = DLineEndXY(ITemp, 1) / DMILI2INCH_DIV '紙上、単位イン
チ　直線は終了
DPositionY2_AtPaper_Inch = DLineEndXY(ITemp, 2) / DMILI2INCH_DIV

Set VisioShapeObj = ActivePage.DrawLine(DPositionX1_AtPaper_Inch, DPositionY1_AtPaper_Inc
h, DPositionX2_AtPaper_Inch, DPositionY2_AtPaper_Inch)

VisioShapeObj.Cells("EndArrow") = STRCONST_ARROWTYPE
VisioShapeObj.Cells("LineWeight") = STRCONST_ARROWSIZE

Select Case IFactorLevel_Line(ITemp)
Case 0
VisioShapeObj.Cells("LineWeight") = STRCONST_LINEWIDTH_FORLEVEL0
Case 1
VisioShapeObj.Cells("LineWeight") = STRCONST_LINEWIDTH_FORLEVEL1
Case Else
VisioShapeObj.Cells("LineWeight") = STRCONST_LINEWIDTH_FORLEVELOTHERS
End Select

'文字列表示
StrText = StrFactor(ITemp)
DPositionX1_AtPaper_Inch = DStrFactorXY(ITemp, 1) / DMILI2INCH_DIV '紙上、単位イン
チ
DPositionY1_AtPaper_Inch = DStrFactorXY(ITemp, 2) / DMILI2INCH_DIV

'レベル0の時は縦書き。ただし、幅高を逆転させることでボックスを縦長へ
If ITemp = 1 Then
Set VisioShapeObj = ActivePage.DrawRectangle(DPositionX1_AtPaper_Inch - DCONST_LEVEL0_T
EXTWIDTH_INCH, DPositionY1_AtPaper_Inch - DCONST_LEVEL0_TEXTHEIGHT_INCH, DPositionX1_AtPape
r_Inch + DCONST_LEVEL0_TEXTWIDTH_INCH, DPositionY1_AtPaper_Inch + DCONST_LEVEL0_TEXTHEIGHT_
INCH)
Else
Set VisioShapeObj = ActivePage.DrawRectangle(DPositionX1_AtPaper_Inch - DCONST_TEXTWIDT
H_DIVE2_INCH, DPositionY1_AtPaper_Inch - DCONST_TEXTHEIGHT_DIVE2_INCH, DPositionX1_AtPaper_
Inch + DCONST_TEXTWIDTH_DIVE2_INCH, DPositionY1_AtPaper_Inch + DCONST_TEXTHEIGHT_DIVE2_INCH
)
End If

VisioShapeObj.TextStyle = "Basic"
VisioShapeObj.LineStyle = "Text Only"
VisioShapeObj.FillStyle = "Text Only"
VisioShapeObj.Text = StrText
If ITemp = 1 Then
VisioShapeObj.Cells("Char.size").Result("pt") = ITEXTSIZE_LEVEL0_POINT
Else
VisioShapeObj.Cells("Char.size").Result("pt") = ITEXTSIZE_POINT
End If


Next ITemp

MsgBox "図形描画が終了しました。"

End Sub

Private Sub Table_Initial()

For ITemp = 1 To IMAXNUMBER_LINE_XY
DLineStartXY(ITemp, 1) = 0
DLineStartXY(ITemp, 2) = 0
DLineEndXY(ITemp, 1) = 0
DLineEndXY(ITemp, 2) = 0
StrFactor(ITemp) = "" '要因の文字列
DStrFactorXY(ITemp, 1) = 0
DStrFactorXY(ITemp, 2) = 0
IFactorLevel_Line(ITemp) = -1
Next ITemp

DLineStartXY(1, 1) = DPaperWidth * ((1 - DRATELINE_LEVEL0TOPAPER) / 2)
DLineStartXY(1, 2) = DPaperHeight * (1 / 2) 'Yは中央固定

DLineEndXY(1, 1) = DPaperWidth * (1 - (1 - DRATELINE_LEVEL0TOPAPER) / 2)
DLineEndXY(1, 2) = DPaperHeight * (1 / 2) 'Yは中央固定

DStrFactorXY(1, 1) = DLineEndXY(1, 1) + DCONST_TEXTHEIGHT_DIVE2 'レベル0は縦書き 近
似的に通常テキスト高/2を設定しておく
DStrFactorXY(1, 2) = DLineEndXY(1, 2) 'レベル0は縦書き

IFactorLevel_Line(1) = 0

Bool_LevelO_IN = False

'既存図形を全部クリア
Set VisioAppObj = Visio.Application
VisioAppObj.ActiveWindow.Page = ThisDocument.Pages(I_PAGENUMBER)

For Each VisioLayerObj In Application.ActiveWindow.Page.Layers
VisioLayerObj.CellsC(visLayerActive) = True
VisioLayerObj.CellsC(visLayerVisible) = True
Next VisioLayerObj
Set VisioSelctionObj = ActiveWindow.Selection
ActiveWindow.SelectAll
ActiveWindow.Selection.Delete

End Sub

・CSVファイル
（あくまで例のファイル。以下のファイルを（.csvにリネームして）、本マクロのVISIOファイルと同じフォルダに置くこと。ファイル名は「Sample_CE_Diagram.csv」固定。）

#＜＜CE図用データ＞＞,,,
基本的に対策したい事項,,,
,要因1AAA,,
,,要因2aaa,
,,,要因3ああ
,,,要因3いい
,,,要因3あああ
,,,要因3いいい
,,,要因3ああああ
,,要因2bbb,
,,,要因3ああ
,,,要因3いい
,,,要因3あああ
,,,要因3いいい
,,,要因3ああああ
,要因１BBB,,
,,要因2ccc
,,要因2ddd
,,要因2eee
,,要因2fff
,,要因2ggg
,要因1CCC,
,,要因2hhh
,要因1DDD,
,,要因2iii
,,要因2jjj
,,要因2kkk
,要因1EEE,
,,要因2lll
,,要因2mmm
,,要因2nnn
,,要因2ooo
,,要因2ppp,,
,,要因2qqq,,
,,,要因3ううう,
,,,,要因4おっととと
,,,,要因4おっととと２
,,,要因3えええ,
,,,,要因4おっととと
,,,,要因4おっととと２
,,,要因3おおお,
,,,,要因4おっと３
,,,,要因4おっと４
,,要因2rrr,,
,,要因2sss,,

・VISIOの出力
（上記例のCSVファイルを作画したもののJPEGファイル）

【変更履歴】

2020/08/12:ブログ移行の関連で、図や例文をページ内で記述。（内容自体が陳腐化してるけど、移行での実験ということで、、。）