Excel VBA質問箱 IV

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

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


72578 / 76732 ←次へ | 前へ→

【8637】Re:windowの再取得
回答  りん E-MAIL  - 03/10/27(月) 19:41 -

引用なし
パスワード
   めぐ さん、こんばんわ。

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

Excelは2000 , windowsはXP です。

>マクロブック テスト用.xls
>テキストファイルの名前
>【301在庫.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\301在庫.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 '301在庫.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\301在庫.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 '301在庫.xls
  '  .Save
  '  .Close savechanges:=False
  'End With
  '
  Erase ws
  Set wb1 = Nothing: Set wb2 = Nothing: Set wb3 = Nothing
End Sub

エラーになりますか?
0 hits

【8561】windowの再取得 めぐ 03/10/24(金) 9:57 質問
【8563】Re:windowの再取得 INA 03/10/24(金) 11:08 回答
【8564】Re:windowの再取得 つん 03/10/24(金) 11:14 発言
【8565】Re:windowの再取得 INA 03/10/24(金) 11:19 回答
【8566】Re:windowの再取得 つん 03/10/24(金) 11:33 発言
【8567】Re:windowの再取得 INA 03/10/24(金) 11:43 回答
【8573】すんませーん つん 03/10/24(金) 13:06 発言
【8568】Re:windowの再取得 めぐ 03/10/24(金) 11:47 質問
【8569】Re:windowの再取得 INA 03/10/24(金) 11:55 回答
【8574】Re:windowの再取得 めぐ 03/10/24(金) 13:31 質問
【8575】Re:windowの再取得 INA 03/10/24(金) 13:38 回答
【8587】Re:windowの再取得 めぐ 03/10/24(金) 16:33 質問
【8588】Re:windowの再取得 INA 03/10/24(金) 16:36 回答
【8589】Re:windowの再取得 めぐ 03/10/24(金) 16:51 質問
【8592】Re:windowの再取得 INA 03/10/24(金) 18:39 回答
【8611】Re:windowの再取得 めぐ 03/10/27(月) 9:51 質問
【8637】Re:windowの再取得 りん 03/10/27(月) 19:41 回答
【8681】Re:windowの再取得 めぐ 03/10/29(水) 11:19 質問
【8684】Re:windowの再取得 めぐ 03/10/29(水) 11:36 お礼
【8705】Re:windowの再取得 めぐ 03/10/29(水) 16:56 質問
【8812】Re:windowの再取得 りん 03/11/3(月) 23:20 回答
【8879】Re:windowの再取得 めぐ 03/11/7(金) 10:23 質問
【8955】Re:windowの再取得 りん 03/11/11(火) 19:23 回答

72578 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free