Excel VBA質問箱 IV

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

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


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

72653 / 76807

←次へ　｜　前へ→


	【8637】Re:windowの再取得

りん

- 03/10/27(月) 19:41 -


	引用なし

	パスワード

めぐさん、こんばんわ。

ちょっと短くしてみました。
変数や配列に入れて取得しておけば見失わなくてすみますよ。

Excelは2000 , windowsはXP です。

>マクロブック　テスト用.xls
>テキストファイルの名前
>【３０１在庫.txt】
>【センター別在庫】
>【棚在庫】

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
　 '
　 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
　 '↓ここがよくわからないので保留（ペースト先は301在庫.txt?）
　 Set wb1 = Workbooks.Open(Filename:="D:\DATA\サイズ一覧.xls")
　 Range("B2:W9").Copy
　 ActiveWindow.WindowState = xlMinimized
　 With ActiveWindow
　　　　.Top = 4
　　　　.Left = 8.5
　 End With
　 Range("D2").Select
　 ActiveSheet.Paste
　 '
　 Columns("A:D").AutoFit
　 Range("E10").Select
　 ActiveWindow.FreezePanes = True
　 '↑ここまでよくわからない。
　 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 wb2 = Workbooks("テスト用.xls") 'いつ開いたの？
　 Set wb3 = Workbooks.Open(Filename:="D:\DATA\３０１在庫.xls")
　 '
　 For II = 1 To 3
　　　ws(II).Copy before:=wb2.Sheets(II)
　　　ws(II).Copy before:=wb3.Sheets(II)
　　　With ws(II).Parent
　　　　 .Saved = True
　　　　 .Close savechanges:=False
　　　End With
　 Next
　 '
　 '保存していいのかな？
　 '
　 'With wb2 'テスト用.xls
　 '　 .Save
　 '　 .Close savechanges:=False
　 'End With
　 'With wb3 '３０１在庫.xls
　 '　 .Save
　 '　 .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