excel VBA のコードを編集したい

下記VBAのコードですが、「選択範囲をCSVファイルにしてカレントフォルダに出力する」というものですが
これを編集して、どのパソコンでもデスクトップに出力すると編集したいです。

どのようにコードを変更したらいいか、教えていただけないでしょうか？自分ではどうがんばっても変更できそうにありませんでした。

どうかよろしくお願いいたします。


Sub Selection_CSV_Output()

'ファイル名をINPUTBOXで取得
'選択範囲を調べる
'選択範囲の左上から1列づつ最終列までセルの値を取得しカンマを付加した文字列を作成
'1行分の文字列の最後カンマを削除し、改行コードを付加する
'行数分だけ繰り返す
'CSVファイルとして、出力
'確認メッセージをMSGBOXで表示
'テストバージョン

Dim myInBox As String
Dim start_row, start_column, end_row, rows_count, columns_count, end_column As Long
Dim SaveD, d As String
Dim CsvF_name, cellD As String
Dim i, j As Long

'InputBoxでファイル名指定
myInBox = Application.InputBox(Title:="ファイル名", prompt:="拡張子なしのファイル名を入力してください", Default:="001", Left:=100, Top:=100, Type:=2)

If myInBox = "False" Then Exit Sub
'Debug.Print myInBox
'ファイル名
CsvF_name = myInBox & ".csv"
'範囲を調べる
start_row = Selection.Row '開始行
start_column = Selection.Column '開始列
end_row = start_row + Selection.Rows.Count - 1 '終了行
end_column = start_column + Selection.Columns.Count - 1 '終了列
rows_count = Selection.Rows.Count '範囲行数
columns_count = Selection.Columns.Count '範囲列数
'読み込みと出力
Open CsvF_name For Output As #1

For i = start_row To start_row + Selection.Rows.Count - 1 '行の繰り返し

For j = start_column To end_column '列の繰り返し
cellD = Cells(i, j).Value
SaveD = SaveD & cellD & "," 'カンマを付加
Next j
'列の終わり
SaveD = Left(SaveD, Len(SaveD) - 1) '最後の一文字（カンマ）を消す
SaveD = SaveD & vbCrLf '改行コードを付加
'Debug.Print SaveD
Next i

'Debug.Print SaveD
Print #1, SaveD
Close #1

'確認メッセージ
MsgBox CsvF_name & "名でカレントフォルダに作成しました。"

End Sub

No.1 ベストアンサー 回答者： keithin 回答日時： 2011/08/26 21:51

たとえば「Excel vba デスクトップ」といったキーワードでちょっとぐぐってみると，すぐに必要なネタが集まります。

例：
http://www.moug.net/tech/exvba/0060052.htm

そのsample3を参考に作成してみると…



変更前：
myInBox = Application.InputBox(Title:="ファイル名", prompt:="拡張子なしのファイル名を入力してください", Default:="001", Left:=100, Top:=100, Type:=2)
’中略
'ファイル名
CsvF_name = myInBox & ".csv"



変更後：
Dim myPath As String, WSH As Variant

myInBox = Application.InputBox(Title:="ファイル名", prompt:="拡張子なしのファイル名を入力してください", Default:="001", Left:=100, Top:=100, Type:=2)
’中略
Set WSH = CreateObject("Wscript.Shell")
myPath = WSH.SpecialFolders("Desktop") & "\"
Set WSH = Nothing
CsvF_name = myPath & myInBox & ".csv"

といった具合で良いことが判ります。

この回答へのお礼

回答ありがとうございます。
あまりにも全体のコードが難しくて、はなから断念してしまいました。
自分の努力不足を反省します。
勉強になりました。ありがとうございました。

お礼日時：2011/08/27 22:13