| |
おはようございます。
昨日さんまとロンドンブーツを見ながら、つんさんのコードを手本に作っていたら、何となく原因がわかりました。
> ReDim strTougou(.ListCount - 1)
↑ここで先に配列を作っていますが
↓配列に値を入れる時に配列のインデックスをループカウンタを使用
してますね！
多分リストボックスがマルチ選択にしている仮定すると、飛び飛び
選択した場合、配列に何も入ってない個所が出来るわけでぇ〜。
要するに配列の中身が不完全の性じゃないかと....。
全部選択した時は、まともに動きませんでしたか！
> For i = 0 To .ListCount - 1
> strTougou(i) = """'" & ActiveWorkbook.Path & "\[" & ActiveWorkbook.Name & "]" & .List(i) & "'!" & pr_strAddress & """"
>
> Next i
で、テレビ見ながら作ったものです。
マクロブック等にコードを書くとして、アクティブシートに書き込むようにしてあります。
変更の余地はいっぱいあると思います。
尚、範囲等は直してください。
標準モジュール
Public ACWB As Workbook, TWB As Workbook
Public TWBpt As String, TWBNm As String
Sub tougou()
Dim Fname As Variant
Dim LstTB() As String
Set ACWB = ActiveWorkbook
Fname = Application.GetOpenFilename("統合ファイル(*.xls),*.xls", , "Open Files (XLS)")
If Fname = False Then Exit Sub
Set TWB = Workbooks.Open(Fname)
ReDim LstTB(1 To TWB.Worksheets.Count)
For i = 1 To TWB.Worksheets.Count
LstTB(i) = TWB.Worksheets(i).Name
Next
TWBpt = TWB.Path
TWBNm = TWB.Name
With UserForm1
'リストボックスをマルチ選択にする。
.ListBox1.MultiSelect = fmMultiSelectExtended
.ListBox1.List = LstTB
Erase LstTB
.Show
End With
End Sub
フォームモジュール
（リストボックス、ボタンが１個づつあるとして）
Private Sub CommandButton1_Click()
Dim ShTb() As String, RCAd As String, CNT As Integer
RCAd = Range("A2:E11").Address(, , xlR1C1)
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
CNT = CNT + 1
ReDim Preserve ShTb(1 To CNT)
ShTb(CNT) = "'" & TWBpt & "\[" & TWBNm & "]" & ListBox1.List(i) & "'!" & RCAd
End If
Next
ACWB.Sheets(1).Range("C3").Consolidate Sources:=ShTb, Function:=xlSum, _
TopRow:=False, LeftColumn:=False, CreateLinks:=False
TWB.Close (False)
Set ACWB = Nothing
Set TWB = Nothing
DoEvents
Unload Me
End Sub
|
|
Jaka
- 05/5/18(水) 9:36 -
