電子書籍の厳選無料作品が豊富!

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

A 回答 (4件)

エクセルVBAを使って、ツールらしきものを作ってみました。


新規ブックにSheet1(この名前のシートが必要。、他のシートでは、下記コードでは不可)を用意し、使うこと。
ーーーー
VBEの画面のModule1の画面に下記をコピーし貼り付ける。
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
上記をコピーして、VBE画面のMojule1に張り付ける。
実行する(F5キーを押す)と、Sheet1が、原稿用紙のような枠線になる。
そしてコンボボックスが1つ出て、親子ー兄弟ー抹消の3項目が選べる。
ーーー
VBEのSheet1の「シートモジュール」の画面に、下記をコピーして、貼り付ける。
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
を貼り付ける。
ーーー
Sheet1の画面に戻り
256列ある列で、始祖(一番上先頭にくる(ひいおじいちゃんぐらい?)を真ん中列(100列目でCV列)あたりからはじめる。
ピラミッドがた・末広がりに広がるから。
ーーー
親子=垂直配置
コンボボックスを「親」を選んでおいて、右上セルをダブルクリック
すると、上ひげ+四角+下ひげが書かれる
ダブルクリックする位置と四角が書かれる位置をつかんでください。
ーーー
兄弟(姉妹)=水平配置
コンボボックスを「兄弟」を選んでおいて、右上セルをダブルクリックすると、カギ型上ひげ+四角+下ひげが書かれる。
左に上のカギひげを伸ばすか、右に伸ばすかは、プログラムで判断する。
ーーー
抹消=罫線抹消とセル結合を解除
名の通り。
どの範囲の罫線等が、抹消されるか、つかんでください。
ーーーーーー
練習が終わったら、編集ークリアー全てでA1:A3以外を抹消してください。
========
本番では、
セルの位置は、左右列は2列空けて、次ぎの2列の右側セルをダブルクリックするようにしてください。
行は上のひげのすぐ下の行を選びます。そしてダブルクリックします。
==ボックス等の位置は、ユーザーが責任を持って適当に決める主義の仕様になっていますからよろしく。
やはり簡単なメモでも事前に作ってから、エクセルシートに向かう、ことが必要と思います。
===全般に小生の力が不足しているのと、質問締め切りも気にしてやりましたので、至らない点はお許しください。
ーーー
注意
●抹消後に、不要な「ひげ」が残るかもしれませんが、お手数ですが、通常のエクセルの罫線抹消の操作で消してください。
●また、兄弟追加のとき、家系のツリーの右端にくる人のボックスがA-E列に、こないようにしてください。エラーが出ます。
●コンボボックスの位置の移動はデザインモードにして、CTRL+Xで切り取り、それから望みの場所でCTRL+Vで貼り付け移動してください。そしてデザインモードをOFFにする。
(ツールバーの定規と鉛筆のアイコンを、クリックして、へこましたり、戻したりするとデザインモードがON/OFF切り替えられます。)
    • good
    • 0

こんにちは。



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

挿入-図-組織図

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

オートシェイプの書式設定-配置-方向(N)




を選びます。

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

#2です。


●#2で、説明でもれたところを補充します。
Sheet1にリストボックスを1つ貼り付ける。(コンボをリスト
ボックスに下記の理由で変更)
●改良する
(1)Sheet1を全部クリアしてやり直ししても大丈夫なように。
(2)コンボに比べ親子・兄弟・抹消が常時見えているし、選択分も色が付いて、見えているので。
Module1に貼り付けるコードを下記に改める。
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
●関連して
Sheet1のシートモジュールに貼り付けるコードも修正
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
●注意点(再説明)
2列x4行の、右上セルをクリックすると、その8つのセルに、兄弟の場合はそれにプラス線を3列伸ばして行きます。
このコツを覚えてください。
    • good
    • 0

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

    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!