VBAの動的リストボックス

Question

ここでは私のコードです：

Private Sub UserForm_Initialize() 

Dim MyFolder As String 
Dim MyFile As String 
Dim j As Integer 
Dim Funds(1000) 

CD_Date = Cells(1, 4) 

Range("A2").Select 

i = 1 

Do 
Funds(i) = UCase(ActiveCell.Value) 
i = i + 1 
ActiveCell.Offset(1, 0).Select 
Loop Until ActiveCell.Value = "" 

MyFolder = "C:\windows\" 

r = 0 

For k = 1 To i - 1 

MyFile = Dir$(MyFolder & "*" & Funds(k) & "*") 
Do While MyFile <> "" 
    datka = FileDateTime(MyFolder & MyFile) 
    If Format(datka, "yymmdd") = Format(CD_Date, "yymmdd") Then 
     With UserForm1.ListBox1 
      .AddItem 
      .List(r, 0) = Funds(k) 
      .List(r, 1) = MyFile 
      r = r + 1 
     End With 
    End If 
    MyFile = Dir$ 
Loop 

Next k 

Range("A2").Select 


End Sub 

コード完璧に動作しますが、私は前の日または現在のためにCD_Dateを移動すると、それが動的に変更されません - 2.それは、常に入力された日付の項目を追加してのみ最初の実行のために。セルの日付を変更すると、常に最初の初期化からリストが返されます。ファイルを閉じて別の日付のたびに再度開くとリセットされます。 CD_Dateを変更した後、または誰かがフォルダにファイルを追加した後に、動的に満たされるコードを変更することは可能ですか？私は閉鎖を避けたいだけ実際のデータを取得するために何度もマクロを開く:(

Answer 1

あなたがアイテムを効果的にそれぞれをリフレッシュするために追加されたコード内のポイントの前にリストボックスからすべての項目を削除するためにループに追加することができます。あなたのコードで

With UserForm1.ListBox1 
    For i = 1 to .ListCount 
     .RemoveItem(0) 
    Next i 
End With 

ここでループが不要にその良いですが、ので、それは、あなたが唯一のリストボックスで一つの項目をするフォームを開くたびのように思える：あなたが何かを探しているこれを行うには時間項目を追加する直前にモジュールに配置してみてください：

Private Sub UserForm_Initialize() 

Dim MyFolder As String 
Dim MyFile As String 
Dim j As Integer 
Dim Funds(1000) 

CD_Date = Cells(1, 4) 

Range("A2").Select 

i = 1 

Do 
Funds(i) = UCase(ActiveCell.Value) 
i = i + 1 
ActiveCell.Offset(1, 0).Select 
Loop Until ActiveCell.Value = "" 

MyFolder = "C:\windows\" 

r = 0 

For k = 1 To i - 1 

MyFile = Dir$(MyFolder & "*" & Funds(k) & "*") 
Do While MyFile <> "" 
    datka = FileDateTime(MyFolder & MyFile) 
    If Format(datka, "yymmdd") = Format(CD_Date, "yymmdd") Then 
     With UserForm1.ListBox1 
      For i = 1 to .ListCount 'Here 
       .RemoveItem(0) 
      Next i 
      .AddItem 
      .List(r, 0) = Funds(k) 
      .List(r, 1) = MyFile 
      r = r + 1 
     End With 
    End If 
    MyFile = Dir$ 
Loop 

Next k 

Range("A2").Select 


End Sub