| |
恐れ入りますが，お力をお貸し下さい。
Ａ列 Ｂ列 Ｃ列
１行 保存場所 ファイル名 シート名
２行
上記のように2行目以降に保存場所，ファイル名及びシート名を入力するさせようと考えています。
その方法として，Worksheet_BeforeDoubleClick イベントを利用し，B列はダブルクリックすることで，Worksheet_BeforeDoubleClick イベントを発生させ，ファイル選択画面（GetOpenFilename）からファイル名を取得させます。
同時にA列にそのパスを記入させます。
C列もダブルクリックイベントを発生させ，ブックの全シート名をリスト化して必要なシートを選択入力させようと考えています。
以下のコードにしてみました。
'----- 全てシートモジュールに -------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim OpenFile As String
Dim SearchFile As String
Dim MyFName As String
Dim MyCell As String
Dim shn() As Long
Dim FileCounter As Long
Dim i As Long
If Application.Intersect(Target, Range("B2:C65535") Is _
Nothing Then Exit Sub
Select Case Target.Column
Case 2
MyCell = ActiveCell
MyFName = Application.GetOpenFilename _
(Title:="ファイルを選んで下さい", _
FileFilter:="Excelファイル(*.xls),*xls")
If MyFName = "False" Then
ActiveCell = MyCell
Else
ActiveCell = Dir(MyFName)
End If
ActiveCell.Offset(, -1) = CurDir
Case 3
OpenFile = ActiveCell.Offset(, -1)
FilePath = ActiveCell.Offset(, -2)
SearchFile = FilePath & "\" & OpenFile
If SearchFile = "" Then Exit Sub
Application.ScreenUpdating = False
Workbooks.Open SearchFile
FileCounter = Worksheets.Count
For i = 1 To FileCounter
ReDim Preserve shn(i): shn(i) = Sheets(i).Name
Next i
With Selection.Validation
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=" ※ここの記述の仕方がわかりません！ "
End With
Workbooks(OpenFile).Close (False)
Application.ScreenUpdating = True
End Select
Cancel = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Application.Intersect(Target, Range("C2:C65535")) Is _
Nothing Then Exit Sub
If Target.Column = 3 Then
With Selection.Validation
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween
End With
End If
End Sub
上記の※のところなのですが，取得した変数shn(i)をリスト化したいのですが，どのように記述したらよいのか分かりませんでした。
どのようにすればよいのでしょうか？よろしくお願いします。
|
|
多摩川
- 07/7/6(金) 8:24 -
