SCHOOL　OF　VBA　そのあとに　その３

SCHOOL　OF　VBA　そのあとに　その３

こんにちは。伊川(@naonaoke)です。

長らくお待たせしました。

さぼっていたわけではないのですが、時間をおいて申し訳ありませんでした。

今回は、作成したファイルを自動で保存します。

特殊フォルダの取得

作成したファイルをデスクトップに自動保存します。

その際に必要な知識は、WScript.Shell,SpecialFoldersプロパティです。

CreateObject関数で作成したWscript.ShellのSpecialFoldersプロパティで、

特殊フォルダを示す文字列を引数に指定して特殊フォルダを取得します。

デスクトップのフォルダ、スタートメニューのフォルダ、個人用ドキュメントのフォルダなどを取得できます。

自動保存　作業手順　その1　コード抜粋

CreateObject関数で作成したオブジェクトを利用するにはCreateObject関数の戻り値を

Setステートメントでオブジェクト変数に代入します。

この書き方でデスクトップを取得できます。

自動保存　作業手順　その3　コードを解説

Sheet2を選択

最終行を取得

条件分岐で判定する

もし、セルC2の文字数が、0以上だったら

出力範囲を設定します。

新しいシートを作成して、選択したデータを新しいシートにコピー

CSVで出力するコード

これで、自動でデスクトップに作成した数値が自動保存されます。

Sub CSVファイルへ出力()
    Dim i As Long
    Dim rng As String
    Dim Path As String, WSH As Variant
    Set WSH = CreateObject("WScript.Shell")
    Path = WSH.SpecialFolders("Desktop") & "\"
    
     Sheets(2).Activate
     
     maxrow = Cells(Rows.Count, 4).End(xlUp).Row
     For i = 2 To maxrow
     
     If Len(Worksheets(2).Range("C2")) > 0 Then
     
     Worksheets(2).Range("C2:U13").Select
     rng = Selection.Address '選択範囲のセルアドレス
     sname = Worksheets(2).Name 'シート名
     Worksheets(sname).Range(rng).Copy Destination:=Worksheets.Add.Range("A1") '新しいシートを追加し、選択範囲をコピー
     ActiveSheet.Move '新しいブックを作成し、そこにシートを移動する
      Application.DisplayAlerts = False '上書きのメッセージを表示させない
        ActiveWorkbook.SaveAs Filename:=Path & Left(ActiveSheet.Range("A2"), 14), FileFormat:=xlCSV

    ActiveWorkbook.Close SaveChanges:=False '保存せずに閉じる
   
    Application.DisplayAlerts = True 'メッセージ表示を戻す
   
    Set WSH = Nothing
 

     
   End If
   
   Next i
   
   
   
   MsgBox "出力完了"
   
   End Sub

ここがポイント

ここがポイント

全自動で保存されます。名前を付けて保存等、面倒な作業を依頼すると売れません。最初は、何時間も考えました。一度覚えると、カンタンなもので、パーツを組み合わせる感覚です。

まとめ

一応、ACCESSへの転送等もあるのですが、それは、一般公開の動画で紹介しています。

ここでは、割愛します。

Related posts:

Excel　罫線を引いてみる　 Excel　配列のわからない人集合　その2 【Excel】VBA　For ～Next構文を説明 【Excel　VBA】Fcuntionを利用すると本当に便利なのか？難しくないFcuntion