| |
「コマンドボタンクリックで、エクセルファイル（複数の場合があります）を選択して開き取得した値を、
新規別ブックで保存」という動作をさせたいです。
エクセルファイル選択キャンセルした際の抜け方がわからないのと、
構文をもっと簡潔にする方法がありましたら ご指導お願いします。
（エクセルのバージョンは2000です）
Private Sub CommandButton1_Click()
Dim FName As Variant
Dim x As Variant
Dim SourceName As String
Dim a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s As Variant
Dim t1, t2, t3, t4, t5, t6 As Variant
FName = Application.GetOpenFilename( _
FileFilter:="Excelファイル,*.xls,すべてのファイル,*.*", _
MultiSelect:=True)
i = 1
For Each x In FName
Workbooks.Open Filename:=x
Worksheets(1).Activate
a = Worksheets(1).Range("G1").Value
b = Worksheets(1).Range("G2").Value
' c〜sまでデータを格納
t1 = Worksheets(1).Range("a17:a30").Value
t2 = Worksheets(1).Range("b17:b30").Value
t3 = Worksheets(1).Range("j17:j30").Value
t4 = Worksheets(1).Range("n17:n30").Value
t5 = Worksheets(1).Range("p17:p30").Value
t6 = Worksheets(1).Range("s17:s30").Value
ActiveWorkbook.Close
CreateNewBook
Worksheets("Sheet1").Range("A6").Value = a
Worksheets("Sheet1").Range("B6").Value = b
' c〜sの値を新しいシートのセルに格納
Worksheets("Sheet1").Range("T6:t19").Value = t1
Worksheets("Sheet1").Range("u6:u19").Value = t2
Worksheets("Sheet1").Range("v6:v19").Value = t3
Worksheets("Sheet1").Range("w6:w19").Value = t4
Worksheets("Sheet1").Range("x6:x19").Value = t5
Worksheets("Sheet1").Range("y6:y19").Value = t6
i = i + 1
'ファイル名を付けて保存
ActiveWorkbook.SaveAs Filename:=Format(Now, "yy-mm-dd hh-mm-ss") & CStr(i) & ".xls"
ActiveWorkbook.Close
Next x
End Sub
Sub CreateNewBook()
Workbooks.Open "出力フォーム.xls"
Worksheets("Sheet1").Activate
End Sub
|
|
kino
- 05/10/30(日) 18:28 -
