家系図を作りたいのですが・・・

質問

家系図をつくりたいのですが、どのように作ったらよいでしょうか？
いわゆる徳川何代目というように文字は縦書きにしたいです。ワードとエクセルのどちらがよいですかね？　また作る場合、どのように設定したらよいのか教えてください。

回答No.2

imogasi · ベストアンサー

エクセルＶＢＡを使って、ツールらしきものを作ってみました。
新規ブックにＳｈｅｅｔ１（この名前のシートが必要。、他のシートでは、下記コードでは不可）を用意し、使うこと。
ーーーー
ＶＢＥの画面のＭｏｄｕｌｅ１の画面に下記をコピーし貼り付ける。
Sub test01()
Application.ScreenUpdating = False
Cells.MergeCells = False
Cells.Clear
Worksheets("Sheet1").Cells.ColumnWidth = 2.5
For i = 1 To 100 Step 3
Cells(i, "A").RowHeight = 14
Cells(i + 1, "A").RowHeight = 14
Cells(i + 2, "a").RowHeight = 70
Next i
Application.ScreenUpdating = True
Range("A1") = "親子"
Range("A2") = "兄弟"
Range("A3") = "抹消"
Worksheets("Sheet1").ComboBox1.ListFillRange = "A1:A3"
End Sub
上記をコピーして、ＶＢＥ画面のＭｏｊｕｌｅ１に張り付ける。
実行する（Ｆ５キーを押す）と、Ｓｈｅｅｔ１が、原稿用紙のような枠線になる。
そしてコンボボックスが１つ出て、親子ー兄弟ー抹消の３項目が選べる。
ーーー
ＶＢＥのＳｈｅｅｔ１の「シートモジュール」の画面に、下記をコピーして、貼り付ける。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
c = Target.Column
r = Target.Row
'--
If Worksheets("Sheet1").ComboBox1 = "親子" Then
Target.Borders(xlLeft).Weight = xlThick
Cells(r + 1, c).Borders(xlLeft).Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).Borders.Weight = xlThick
Cells(r + 3, c).Borders(xlEdgeLeft).Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).MergeCells = True
Cells(r + 2, c - 1).Orientation = xlVertical
'Exit Sub
'----
ElseIf Worksheets("Sheet1").ComboBox1 = "兄弟" Then
If Range(Cells(r + 2, c - 5), Cells(r + 2, c - 5)).Borders(xlLeft).LineStyle <> xlNone Then
MsgBox "右付け"
Range(Cells(r, c - 4), Cells(r, c - 1)).Borders(xlBottom).Weight = xlThick
Cells(r + 1, c).Borders(xlLeft).Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).Borders.Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).MergeCells = True
Cells(r + 2, c - 1).Orientation = xlVertical
Else
MsgBox "左付け"
Range(Cells(r, c), Cells(r, c + 3)).Borders(xlBottom).Weight = xlThick
'---
Cells(r + 1, c).Borders(xlLeft).Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).Borders.Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).MergeCells = True
Cells(r + 2, c - 1).Orientation = xlVertical
End If
'Exit Sub
'-----
ElseIf Worksheets("Sheet1").ComboBox1 = "抹消" Then
Range(Cells(r + 1, c - 1), Cells(r + 3, c)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.MergeCells = False
Cells(r, c).Borders(xlEdgeLeft).LineStyle = xlNone
End If
End Sub
を貼り付ける。
ーーー
Ｓｈｅｅｔ１の画面に戻り
２５６列ある列で、始祖（一番上先頭にくる（ひいおじいちゃんぐらい？）を真ん中列（100列目でＣＶ列）あたりからはじめる。
ピラミッドがた・末広がりに広がるから。
ーーー
親子＝垂直配置
コンボボックスを「親」を選んでおいて、右上セルをダブルクリック
すると、上ひげ＋四角＋下ひげが書かれる
ダブルクリックする位置と四角が書かれる位置をつかんでください。
ーーー
兄弟（姉妹）＝水平配置
コンボボックスを「兄弟」を選んでおいて、右上セルをダブルクリックすると、カギ型上ひげ＋四角＋下ひげが書かれる。
左に上のカギひげを伸ばすか、右に伸ばすかは、プログラムで判断する。
ーーー
抹消＝罫線抹消とセル結合を解除
名の通り。
どの範囲の罫線等が、抹消されるか、つかんでください。
ーーーーーー
練習が終わったら、編集ークリアー全てでＡ１：Ａ３以外を抹消してください。
＝＝＝＝＝＝＝＝
本番では、
セルの位置は、左右列は２列空けて、次ぎの２列の右側セルをダブルクリックするようにしてください。
行は上のひげのすぐ下の行を選びます。そしてダブルクリックします。
＝＝ボックス等の位置は、ユーザーが責任を持って適当に決める主義の仕様になっていますからよろしく。
やはり簡単なメモでも事前に作ってから、エクセルシートに向かう、ことが必要と思います。
＝＝＝全般に小生の力が不足しているのと、質問締め切りも気にしてやりましたので、至らない点はお許しください。
ーーー
注意
●抹消後に、不要な「ひげ」が残るかもしれませんが、お手数ですが、通常のエクセルの罫線抹消の操作で消してください。
●また、兄弟追加のとき、家系のツリーの右端にくる人のボックスがＡ－Ｅ列に、こないようにしてください。エラーが出ます。
●コンボボックスの位置の移動はデザインモードにして、ＣＴＲＬ＋Ｘで切り取り、それから望みの場所でＣＴＲＬ＋Ｖで貼り付け移動してください。そしてデザインモードをＯＦＦにする。
（ツールバーの定規と鉛筆のアイコンを、クリックして、へこましたり、戻したりするとデザインモードがＯＮ／ＯＦＦ切り替えられます。）

回答No.4

Wendy02

こんにちは。

#1さんがWordでおっしゃっているので、Excelでは、組織図が該当します。
[組織図を出す]

挿入－図－組織図

組織図の描画領域と組織図ツールバーが出てきたら、領域の中のそれぞれの角丸の四角の枠のところで、右クリック

オートシェイプの書式設定－配置－方向(N)
文
字
列

を選びます。

色と線では、透明（塗りつぶしなし）にしたり、色を変えたりします。
（Excel2003)

回答No.3

imogasi

＃２です。
●＃２で、説明でもれたところを補充します。
Ｓｈｅｅｔ１にリストボックスを１つ貼り付ける。（コンボをリスト
ボックスに下記の理由で変更）
●改良する
（１）Ｓｈｅｅｔ１を全部クリアしてやり直ししても大丈夫なように。
（２）コンボに比べ親子・兄弟・抹消が常時見えているし、選択分も色が付いて、見えているので。
Ｍｏｄｕｌｅ１に貼り付けるコードを下記に改める。
Sub test01()
Application.ScreenUpdating = False
Cells.MergeCells = False
Cells.Clear
Worksheets("Sheet1").Cells.ColumnWidth = 2.5
For i = 1 To 100 Step 3
Cells(i, "A").RowHeight = 14
Cells(i + 1, "A").RowHeight = 14
Cells(i + 2, "a").RowHeight = 70
Next i
Application.ScreenUpdating = True
'---
Worksheets("Sheet1").ListBox1.Clear 'RemoveAllItems
Worksheets("Sheet1").ListBox1.AddItem "親子"
Worksheets("Sheet1").ListBox1.AddItem "兄弟"
Worksheets("Sheet1").ListBox1.AddItem "抹消"
End Sub
●関連して
Ｓｈｅｅｔ１のシートモジュールに貼り付けるコードも修正
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
c = Target.Column
r = Target.Row
'--
If Worksheets("Sheet1").ListBox1 = "親子" Then
Target.Borders(xlLeft).Weight = xlThick
Cells(r + 1, c).Borders(xlLeft).Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).Borders.Weight = xlThick
Cells(r + 3, c).Borders(xlEdgeLeft).Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).MergeCells = True
Cells(r + 2, c - 1).Orientation = xlVertical
'Exit Sub
'----
ElseIf Worksheets("Sheet1").ListBox1 = "兄弟" Then
If Range(Cells(r + 2, c - 5), Cells(r + 2, c - 5)).Borders(xlLeft).LineStyle <> xlNone Then
MsgBox "右付け"
Range(Cells(r, c - 4), Cells(r, c - 1)).Borders(xlBottom).Weight = xlThick
Cells(r + 1, c).Borders(xlLeft).Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).Borders.Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).MergeCells = True
Cells(r + 2, c - 1).Orientation = xlVertical
Else
MsgBox "左付け"
Range(Cells(r, c), Cells(r, c + 3)).Borders(xlBottom).Weight = xlThick
'---
Cells(r + 1, c).Borders(xlLeft).Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).Borders.Weight = xlThick
Range(Cells(r + 2, c - 1), Cells(r + 2, c)).MergeCells = True
Cells(r + 2, c - 1).Orientation = xlVertical
End If
'Exit Sub
'-----
ElseIf Worksheets("Sheet1").ListBox1 = "抹消" Then
Range(Cells(r + 1, c - 1), Cells(r + 3, c)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.MergeCells = False
Cells(r, c).Borders(xlEdgeLeft).LineStyle = xlNone
End If
End Sub
●注意点（再説明）
２列ｘ４行の、右上セルをクリックすると、その８つのセルに、兄弟の場合はそれにプラス線を３列伸ばして行きます。
このコツを覚えてください。

回答No.1

isoyujin

元来表作りはエクセルに任せた方が良いと思いますが、ワードでフローチャートの雛形があるので、そちらをお使いになれば良いと思います。