| |
▼neptune さん：
3月初旬までに解決できるとうれしいです。よろしくお願いします。
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
1）標準モジュール[Module1]を追加して、次の行を追加してして下さい。
Public Sub Auto_Open : Form1.Show vbModeless : End Sub
2）フォーム[Form1]を追加して、コマンドボタン[cmd1]と、ツリービュー[tvw1]を置いて下さい。
3）[Form1]に以下の行を挿入して下さい。
4）実行してみて下さい。
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Option Explicit
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Private Type EventData
datDate As Date
strTitle As String
End Type
Private Events() As EventData
Private Type ListKey
datKey As Date
strKey As String
strName As String
End Type
Private ListKeys(1 To 12) As ListKey
Private intY As Integer '[年]
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Private Sub cmd1_Click()
Call UpdateTreeView 'TreeViewを再描画します。
End Sub
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Private Sub UserForm_Initialize()
intY = Year(Now())
Call CreateDummyEvent 'テスト用データを作成します。
With cmd1
.Caption = "TreeViewを再描画します"
End With
With tvw1
.HotTracking = True 'True：表示文字に下線を表示する。
.BorderStyle = ccNone '線の種類
.Font.Size = 12
.FullRowSelect = False 'False：選択された文字だけ色付けする。 True：選択された行全体を色付けする。
.Indentation = 14 'インデントの幅
.LabelEdit = tvwManual 'ラベル編集の許可
.LineStyle = tvwRootLines 'ルート(最上位)線の表示
.HideSelection = False '非アクティブ時の選択解除
.Scroll = True
.CheckBoxes = False 'True：チェックボックスを表示する。
'.ImageList = ImageList1 'イメージリストの初期化
End With
Call UpdateTreeView 'TreeViewを再描画します。
End Sub
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Private Sub UpdateTreeView()
Dim intM As Integer, intI As Integer, intJ As Integer, intK As Integer
With tvw1
.Nodes.Clear '[TreeView]を一括クリアする。'大問題！）[Nodes.Clear]はめちゃくちゃ時間がかかる。
'親（第１位の）ノードを表示する。
For intM = 1 To 12
ListKeys(intM).datKey = DateSerial(intY, intM, 1)
ListKeys(intM).strKey = "KEY" & Format(ListKeys(intM).datKey, "YYYYMM")
ListKeys(intM).strName = Format(ListKeys(intM).datKey, "gggee年MM月") & "（" & Format(ListKeys(intM).datKey, "YYYY年") & "）"
.Nodes.Add Key:=ListKeys(intM).strKey, Text:=ListKeys(intM).strName
.Nodes(ListKeys(intM).strKey).Expanded = True 'ノードを展開する（このノードの子ノードを表示する）。
Next intM
'子（第２位の）ノードを表示する。
intI = 1: intJ = 1 '初期値を設定する。
For intM = 1 To UBound(ListKeys) '＝親ノード数
intK = 1 '初期値を設定する。
For intI = intJ To UBound(Events)
If (Year(ListKeys(intM).datKey) = Year(Events(intI).datDate)) And (Month(ListKeys(intM).datKey) = Month(Events(intI).datDate)) Then
'下位の（第２位の）ノードを格納する。
.Nodes.Add Relative:=ListKeys(intM).strKey, Relationship:=tvwChild, Key:=ListKeys(intM).strKey & Format(intK, "_00"), Text:=Events(intI).strTitle
intK = intK + 1
Else '翌月の[行事]が見つかった。
Exit For
End If
Next intI
intJ = intI
Next intM
End With
End Sub
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−
Private Sub CreateDummyEvent()
Dim intM As Integer, intI As Integer, intJ As Integer, intK As Integer, datDate As Date, strTitle As String
ReDim Events(1 To 500)
intK = 0
For intM = 1 To 12
For intI = 1 To 20
datDate = DateSerial(intY, intM, intI)
strTitle = Format(datDate, "gggee年MM月DD日(aaa)") & "_行事_"
For intJ = 1 To 10: strTitle = strTitle & Format(intI, "00"): Next intJ
intK = intK + 1: Events(intK).datDate = datDate: Events(intK).strTitle = strTitle
Next intI
Next intM
ReDim Preserve Events(1 To UBound(Events))
End Sub
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
|
|
四国は久々晴れ、でも
- 11/1/7(金) 11:06 -
