みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel2003VBAでファイルをコピーして指定場所に保存

こんにちわ。
私は下記のコードで保存場所をCドライブに指定しているのですが、これを保存先が選べるようにするのはどうすれば良いですか?

Application.DisplayAlerts = False
Set OldWkbook = ActiveWorkbook
'
'ファイル名を取得
BkName1 = OldWkbook.Sheets(StName1).Range("E1").Value
BkName2 = OldWkbook.Sheets(StName1).Range("E2").Value
BkName3 = OldWkbook.Sheets(StName1).Range("E3").Value

FileName = BkName1 & Format(".") & Format("試験結果") & Format(".") & BkName2 & Format(".") & BkName3 & ".xls"


FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName)


If FileName = "" Then
Exit Sub
Else
If Right(FileName, 4) <> ".xls" Then
MsgBox "ファイル名が異常です。"
Exit Sub
End If
End If

'シートの保護を解除
Worksheets("Sheet1").Unprotect
Worksheets("Sheet2").Unprotect
Worksheets("Sheet3").Unprotect

OldWkbook.Sheets(Array(StName1, StName2, StName3, StName4, StName5)).copy


Set NewWkbook = ActiveWorkbook



'ボタンを削除
For wIx = NewWkbook.Sheets(1).Shapes.Count To 1 Step -1
If Left(NewWkbook.Sheets(1).Shapes(wIx).Name, 6) = "Button" Then 'ボタンのみ削除
NewWkbook.Sheets(1).Shapes(wIx).Delete
End If
Next



NewWkbook.Sheets(1).Name = StName1

'コピー先シートの保護
Sheets(1).Protect
Sheets(2).Protect
Sheets(3).Protect
Sheets(4).Protect
Sheets(5).Protect


FileName = "C:\" & FileName

If Dir(FileName) <> "" Then
'##ファイルが既に存在する
If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then

NewWkbook.Close savechanges:=False

'##保存せずに終了
'シートの保護
Worksheets("Sheet1").Protect
Worksheets("Sheet2").Protect
Worksheets("Sheet3").Protect
Exit Sub
'##指定ファイル置き換え保存
End If
NewWkbook.SaveAs FileName:=FileName
Else
'##ファイルを新規保存
NewWkbook.SaveAs FileName:=FileName
End If

NewWkbook.Close savechanges:=False
Application.DisplayAlerts = True

'シートの保護
Worksheets("Sheet1").Protect
Worksheets("Sheet2").Protect
Worksheets("Sheet3").Protect


End Sub

投稿日時 - 2008-10-07 09:33:10

QNo.4383463

すぐに回答ほしいです

質問者が選んだベストアンサー

No3です。
以下のようにしてみてください。

  Filename = Application.GetSaveAsFilename(Filename, "XLSファイル (*.xls),*.xls", , "保存するデータ(XLS)")
  If Filename = "False" Then
    '##保存せずに終了
    NewWkbook.Close savechanges:=False
    'シートの保護
    Worksheets("Sheet1").Protect
    Worksheets("Sheet2").Protect
    Worksheets("Sheet3").Protect
    Exit Sub
  End

投稿日時 - 2008-10-08 12:39:24

お礼

出来ました!!
ありがとうございました。

投稿日時 - 2008-10-08 16:15:36

ANo.5

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.4

ファイルの保存に関して
下記をやってみてください。
Sub test01()
Application.Dialogs(xlDialogSaveAs).Show arg1:="C:\Documents and Settings\XXXX\デスクトップ\新しいフォルダ\sample1.xls"
End Sub
上記のarg1:=で
一番指定されそうなフォルダとファイル名を指定するのはどうでしょう。この場合上位フォルダに戻る必要がある場合があるでしょう。
それが手間なら、あるいは
arg1:="C:\Documents and Settings\xxxX\デスクトップ\\sampl.xls"
とすると「デスクトップ」フォルダの一覧が表示され、ファイル名が
samp1.xlsで指定待ちになるようですから、意図するフォルダをクリックすればよい。
ーー
この場合NewWkbook.SaveAs FileName:=FileName
のようなメソッドはコード上に書く必要がなく、ユーザーのダイアロウグの指定とともに、保存が行われるので、注意のこと。
ファイル指定対話(お膳立て)
指定されたファイル名の受け取り
その指定ファイル名での保存
の3つを含んでいると言うことです。
コードがすっきり、引き締まったものになると思います。
ほかに引数もありますので使えないか勉強してください。
http://www.excel7.com/personal/vba_shiryou1.htm
の引数一覧参照。
ーー
Googleで「xldialogsaveas フォルダ指定」で照会すれば記事が出ます。

投稿日時 - 2008-10-07 18:47:30

補足

ご回答ありがとうございます。
まだまだ初心者なのでimogasi様が仰っている意味を完全に理解できていません・・。貼り付けていただいたサイトで勉強してみます。

投稿日時 - 2008-10-08 09:48:59

ANo.3

以下の行を追加して下さい。

Filename = Application.GetSaveAsFilename(Filename, "XLSファイル (*.xls),*.xls", , "保存するデータ(XLS)")
If Filename = "False" Then   '←追加
  Exit Sub          '←追加
End If             '←追加

投稿日時 - 2008-10-07 17:46:06

補足

ご回答ありがとうございます。
ご提示されたコードを追加して実行したところ、キャンセルを選択すると保存はされないのですが、Book1というファイル名が作成されてしまいました。キャンセルを選択したら新しいファイルを作成しないで保存もされないというのを希望しております。

投稿日時 - 2008-10-08 09:44:56

ANo.2

この行を入れるのはどうでしょうか?
「保存」を押すとファイル名がフルパスで入ってきますし、
「キャンセル」を押すと False が入ってきます。

Filename = Application.GetSaveAsFilename(Filename, "XLSファイル (*.xls),*.xls", , "保存するデータ(XLS)")

投稿日時 - 2008-10-07 10:24:34

補足

ご回答ありがとうございます。
FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName)
これを削除して
FileName = "C:\" & FileNameを
Filename = Application.GetSaveAsFilename(Filename, "XLSファイル (*.xls),*.xls", , "保存するデータ(XLS)")に変更したところ、保存できました!しかし、キャンセルした場合にはFalse.xlsというファイル名で保存されてしまいます。キャンセルした場合は保存しないようにしたいのですが可能ですか?

投稿日時 - 2008-10-07 16:34:08

ANo.1

フォルダを選択するダイアログ
http://www.officetanaka.net/excel/vba/tips/tips39.htm

を検討されてみては如何でしょうか?

投稿日時 - 2008-10-07 09:36:20

補足

ご回答ありがとうございます。
是非参考にさせていただきます!

投稿日時 - 2008-10-07 16:37:33

あなたにオススメの質問