Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

72337 / 76807

←次へ　｜　前へ→


	【8955】Re:windowの再取得

りん

- 03/11/11(火) 19:23 -


	引用なし

	パスワード

めぐさん、こんばんわ。
遅くなってすみません。

>３０１在庫.txtの３０１在庫シートに８行挿入し、その行を文字列に置き換えます。
>次にザイコ一覧.xlsにあるデータをコピーしまして、それを３０１在庫.txtの３０１在庫シートのＤ２からはりつけます。

Active(Window,Sheet)やSelectにまかせてシートやブックを移動しながら処理すると、自分の意思と違うところに処理する可能性があるので、出来る限り処理対象のオブジェクトは明確にすることがエラー回避と処理速度向上の第一歩だと思います。

Sub Macro2()
'
' Macro2 Macro
' マクロ記録日 : 2003/10/23　ユーザー名 :
'
　 Dim ws(1 To 3) As Worksheet, II As Integer
　 Dim wb1 As Workbook, wb2 As Workbook
　 '
　 Workbooks.OpenText Filename:="D:\DATA\３０１在庫.txt", _
　　　StartRow:=1, DataType:=xlDelimited, _
　　　TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
　　　Tab:=True, Semicolon:=False, Comma:=True, Space:=False, _
　　　Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 2), _
　　　Array(3, 2), Array(4, 2), Array(5, 1), Array(6, 1), _
　　　Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), _
　　　Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), _
　　　Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
　　　Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
　　　Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
　　　Array(27, 2))
　 Set ws(1) = ActiveSheet '３０１在庫.txt
　 ActiveWindow.FreezePanes = True 'ウィンドウ枠の固定
　 '
　 With ws(1)
　　　With .UsedRange.Borders
　　　　 .LineStyle = xlContinuous
　　　　 .Weight = xlThin
　　　　 .ColorIndex = xlAutomatic
　　　End With
　　　.Rows("1:8").Insert Shift:=xlDown
　　　.Range("D1:AA9").NumberFormatLocal = "@"
　 End With
　 '
　 Set wb1 = Workbooks.Open(Filename:="D:\DATA\サイズ一覧.xls")
　 wb1.Worksheets(1).Range("B2:W9").Copy 'サイズ一覧.xlsの一つめのシートからコピー
　 '３０１在庫.txtのD2にペースト
　 With ws(1)
　　　.Range("D2").PasteSpecial Paste:=xlPasteValues
　　　.Columns("A:D").AutoFit
　 End With
　 Workbooks.OpenText Filename:="D:\DATA\センター別在庫.txt", _
　　　StartRow:=1, DataType:=xlDelimited, _
　　　TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
　　　Tab:=True, Semicolon:=False, Comma:=True, Space:=False, _
　　　Other:=False, FieldInfo:=Array(Array(1, 2), Array(2, 2), _
　　　Array(3, 2), Array(4, 2), Array(5, 1), Array(6, 1), Array(7, 1))
　 '
　 Set ws(2) = ActiveSheet 'センター別在庫.txt
　 With ws(2)
　　　With .UsedRange.Borders
　　　　 .LineStyle = xlContinuous
　　　　 .Weight = xlThin
　　　　 .ColorIndex = xlAutomatic
　　　End With
　　　.Columns("A:D").AutoFit
　 End With
　 '
　 Workbooks.OpenText Filename:="D:\DATA\棚在庫.txt", _
　　　StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
　　　xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
　　　Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
　　　FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), _
　　　Array(4, 2), Array(5, 1), Array(6, 1), Array(7, 1), _
　　　Array(8, 2))
　 Set ws(3) = ActiveSheet '棚在庫.txt
　 '
　 With ws(3)
　　　With .UsedRange.Borders
　　　　 .LineStyle = xlContinuous
　　　　 .Weight = xlThin
　　　　 .ColorIndex = xlAutomatic
　　　End With
　　　.Columns("A:D").AutoFit
　　　.Columns("H").AutoFit
　 End With
　 '
　 Set wb3 = Workbooks.Open(Filename:="D:\DATA\３０１在庫.xls")
　 '
　 For II = 1 To 3
　　　ws(II).Copy before:=wb3.Sheets(II)
　　　With ws(II).Parent
　　　　 .Saved = True
　　　　 .Close savechanges:=False
　　　End With
　 Next
　 '
　 '保存します
　 With wb3 '３０１在庫.xls
　　 .Save
　　 .Close savechanges:=False
　 End With
　 '保存しません
　 With wb2 'テスト用.xls
　　 .Saved = True
　　 .Close savechanges:=False
　 End With
　 '
　 Erase ws
　 Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
End Sub

これでもエラーになりますか？

1 hits

▼

【8561】windowの再取得 めぐ 03/10/24(金) 9:57