Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14463 / 76738 ←次へ | 前へ→

【67771】Re:TreeView.Nodes.Clearが遅い
発言  四国は久々晴れ、でも  - 11/1/7(金) 11:06 -

引用なし
パスワード
   ▼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]はめちゃくちゃ時間がかかる。
  '親(第1位の)ノードを表示する。
  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
  '子(第2位の)ノードを表示する。
  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
     '下位の(第2位の)ノードを格納する。
     .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
'−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−

1 hits

【67739】TreeView.Nodes.Clearが遅い 四国は久々晴れ、でも極寒 11/1/6(木) 10:49 質問
【67740】Re:TreeView.Nodes.Clearが遅い kanabun 11/1/6(木) 11:11 発言
【67742】Re:TreeView.Nodes.Clearが遅い 四国は久々に晴れ、でも 11/1/6(木) 12:10 回答
【67746】Re:TreeView.Nodes.Clearが遅い 四国は久々晴れ、でも 11/1/6(木) 14:20 発言
【67749】Re:TreeView.Nodes.Clearが遅い 四国は久々晴れ、でも 11/1/6(木) 15:40 発言
【67750】Re:TreeView.Nodes.Clearが遅い neptune 11/1/6(木) 15:59 発言
【67771】Re:TreeView.Nodes.Clearが遅い 四国は久々晴れ、でも 11/1/7(金) 11:06 発言
【67776】Re:TreeView.Nodes.Clearが遅い neptune 11/1/7(金) 18:07 発言
【67777】Re:TreeView.Nodes.Clearが遅い 四国は久々晴れ、でも 11/1/7(金) 18:20 お礼
【67871】Re:TreeView.Nodes.Clearが遅い 四国は久々晴れ、でも 11/1/14(金) 10:33 お礼

14463 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free