[[20091215173635]]　『VBAを使って作業自動化したい２』（らいち）　ページの最後に飛ぶ

『VBAを使って作業自動化したい２』（らいち）

※以前に類似のご質問をさせて頂いた内容ですが、改めて教えて下さい。

下記の作業をVBAを使用して自動化したいのですが、全くのVBA初心者のため

わかりませんので、どなたか教えて下さい。

・管理No.を入力すると、LOOKUP関数で各項目のデータを表に表示

　させる管理表ファイルがあります。（Excel2000、WindowsXP）

1)シート上に配置したボタンを押して、VBA起動

2)数値入力指示が出て、管理No.セル（例えばC2）に数値を入力

3)管理表だけを範囲指定（例えばB2:C16）コピーして、新規作成Sheet1に書式と
　値だけをペーストする。
　

4)新規作成Sheet1のペースト基準位置はB2として、A,B,C各列の幅を

　それぞれA列は0.5、B列は10、C列は50に変更

5)新規作成ファイル保存時のファイル名は「管理No.＋文字.xls」、保存先は管理表ファイルと同フォルダ

6)保存後、入力している管理No.セルの数値を消去して、VBA終了

以上です。宜しくお願いします。

 前回スレ
[[20091119145021]]『VBAを使って作業自動化したい』（らいち）

 前回の質問に対する回答者へのフォローをしてから
 新規質問するのが筋じゃないかな？？？
 （小市民）

 １）ボタンにマクロを登録するのはVBAのコードが出来てからなので後回し
２）マクロ起動してからセル入力を促すのは入力するまでマクロを一時
　　中断するということか？
　　マクロ実行後、ターゲットのセルに入力がない場合はメッセージ表示して
　　入力を促す、という仕様にするでしょうね、私なら。
　　InputBoxでも可能なんでしょうけれども、ヒューマンエラーを考慮する必要あり。
３）これはマクロの記録でコード作成。
４）これもマクロの記録でコード作成。
５）ここで、いきなり「新規作成ファイル」が出てくるけど、まっさらのファイルを
　　「名前をつけて保存」すると考えてよいのだろうか。
　　先のC2に入力する管理ナンバーがファイル名として無効な場合の回避方法も必要。
６）これもマクロの記録でコード作成。
　
記録で出来る部分は自分でやってみることです。
そして、どの部分が出来ないか、をはっきりさせるべきですね。
(みやほりん)(-_∂)b

（みやほりん）さん、ご回答ありがとうございます。

早速、下記の通りにトライしてみましたが、

実行時エラー'1004'RangeクラスのSelectメソッドが失敗しました。

と表示され、14行目のRange（"B2"）Selectが黄色反転しました。

どこを直せば良いか、サッパリ分からないので教えて頂けないでしょうか。

よろしくお願いします。

Private Sub タグ作成_Click()

Dim InPt As Long

    Dim SaveName As String
    Dim wb As Workbook
    Set wb = ThisWorkbook
    InPt = Application.InputBox(prompt:="管理No.を入力", Type:=1)
    If InPt = False Then Exit Sub
    With wb.ActiveSheet
        .Range("c3").Value = InPt
    End With
    Range("B2:C16").Select
    Selection.Copy
    Workbooks.Add
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Columns("A:A").Select
    Selection.ColumnWidth = 0.5
    Columns("B:B").Select
    Selection.ColumnWidth = 10
    Columns("C:C").Select
    Selection.ColumnWidth = 50
    Application.CutCopyMode = False
    ChDir "C:\Documents and Settings\123"
    SaveName = "C:\Documents and Settings\123\" & InPt & "タグ.xls"
    ActiveWorkbook.SaveAs Filename:= _
    SaveName, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    Range("c3").Select
    Selection.ClearContents
    wb.Close False
    Set wb = Nothing
End Sub

（らいち）

 これでは？

 Private Sub タグ作成_Click()
    Dim InPt As Long
    Dim SaveName As String
    Dim wb As Workbook, wkbk As Workbook
    Set wb = ThisWorkbook
    InPt = Application.InputBox(prompt:="管理No.を入力", Type:=1)
    If InPt = False Then Exit Sub
    With wb.ActiveSheet
        .Range("c3").Value = InPt
        .Range("B2:C16").Copy
    End With
    Set wkbk = Workbooks.Add
    With wkbk.ActiveSheet
        .Range("B2").PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("B2").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Columns("A:A").ColumnWidth = 0.5
        .Columns("B:B").ColumnWidth = 10
        .Columns("C:C").ColumnWidth = 50
    End With
    SaveName = "C:\Documents and Settings\123\" & InPt & "タグ.xls"
    ActiveWorkbook.SaveAs Filename:=SaveName, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    wb.Close False
    Set wb = Nothing
    Set wkbk = Nothing
 End Sub

 1or8

1or8　様

いつもご丁寧に有難う御座います。
早速、トライしてみたところ、エラーは発生しなくなりました！

今回を機会にVBAの勉強をしてみたいと思います。

また分からない点がありました時には、教えて下さい。

（らいち）

コメント返信：

[ 一覧(最新更新順) ]

[[20091215173635]] 『VBAを使って作業自動化したい２』（らいち） ページの最後に飛ぶ

[[20091215173635]]　『VBAを使って作業自動化したい２』（らいち）　ページの最後に飛ぶ