Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

複数のファイルを1つのシート に貼り付けるについて。

0 views
Skip to first unread message

koun...@mbh.nifty.com

unread,
Aug 1, 2003, 9:20:26 AM8/1/03
to
鴻池です。

"Yoshiaki Kawajiri" <yoshiaki...@toll.co.jp> wrote in message
news:3F2A1C0A...@toll.co.jp...
> 川尻@札幌です。
> #の所まで動きました。繋げるのがよく分かりません。

以下のスタート用マクロを追加。

Sub start_test()
Dim tobook As Workbook
Dim tosheet As Worksheet

Set tobook = ActiveWorkbook
Set tosheet = ActiveSheet
ファイルの読み込み_Click tobook, tosheet
End Sub

その後
川尻さんの作成したものを以下のように修正・追加します。川尻さんのマクロでは,
選択したファイルが開けていません。それでは,私の方法ではコピーできません。
(川尻さんの希望する方法がこういった選択方法とは予想してませんでした。)

> Private Sub ファイルの読み込み_Click() を下記の文に修正
Private Sub ファイルの読み込み_Click(tobook As Workbook, tosheet As
Worksheet)

> Dim tmp As Variant
> Dim i As Integer
> Dim msg As String
Dim ac As Workbook '追加
> tmp = Application.GetOpenFilename("Excel(*.xls),*.xls", , _
> "交通量ファイルを複数選択してください", , True)
> If (VarType(tmp) = vbBoolean) Then
> Exit Sub
> Else
> For i = LBound(tmp) To UBound(tmp)
> msg = msg & Str(i) & ":" & tmp(i) & vbCrLf
> Next i
> End If
> MsgBox msg

'以下追加
For i = LBound(tmp) To UBound(tmp)
Workbooks.Open tmp(i)
Set ac = ActiveWorkbook
start_copysheet tobook, tosheet
ac.Close SaveChanges:=False
Next i

> End Sub

この後ろは,そのまま。

あとは,集計用のシートをアクティブ(選択)にした状態で,start_testを実行。
一つ一つ選択したファイル開いて,コピーしたあと閉じるようにしています。全て開
いてコピーするほうが良いのなら,また変更が必要ですが。
環境が違うのでなんとも言えませんが,確認して見て下さい。

--
******************************
keizi kounoike
******************************

0 new messages