[[20180313210136]] 『VBA 同じフォルダに新しい名前でブックを保存』(あらいぐま) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBA 同じフォルダに新しい名前でブックを保存』(あらいぐま)

Sheet1のセルC4のデータ(文字列)を得て、それを新しいブック名にして
同じフォルダ内に保存したいと考え、次を参考にして、以下のようなマク
ロを考えてみました。

<参考>
Sub SameFolderSave()

     '変数の宣言(自分のブックのフォルダ名格納用)
    Dim thisPath As String
     '自分のブックのフォルダ名を変数に入れる<
     thisPath = ThisWorkbook.Path
     'このブックを同じフォルダ内に別の名前で保存する
    ThisWorkbook.SaveAs Filename:=thisPath & "\新しいブック.xlsm"
 End Sub

<小生が考えたもの>
Sub SameFolderSave()

    Dim thisPath As String  '変数の宣言(自分のブックのフォルダ名格納用)
    Dim newname As String  '変数の宣言(新しいブックの名前格納用)

     thisPath = ThisWorkbook.Path
      '自分のブックのフォルダ名を変数に入れる
     newname = Sheets("Sheet1").Cells(4, 3).Value
      'シート1のC4セルのデータを新しいブック名として変数に入れる

    ThisWorkbook.SaveAs Filename:=thisPath & "\" & newname & ".xlsm"
      'このブックを同じフォルダ内に別の名前で保存する

 End Sub

ところが、構文に問題があるようで、うまく動いてくれません。
どこをどのように訂正すればよいのでしょうか。
解決法をご教授願えないでしょうか。

また、保存時に同名ブックがあるときにはその旨をメッセージ表示し、
保存をしないようにするアイデアも併せ、お教えくださるとありがたいです。

< 使用 Excel:Excel2013、使用 OS:Windows7 >


>うまく動いてくれません。
とは具体的にどういうことから判断しましたか?
エラーになるなら、エラーの内容を。
想定と違う結果なら、どのように違うのか説明ください。

(γ) 2018/03/13(火) 22:30


 私のパソコンでは正しく動いてます。
 やってみるとしたら、デバッグ(Debug.Print+Exit Sub)でしょうね。

 最初にチェックするのは、Sheets("Sheet1").Cells(4, 3).Valueで、
 Sheets("Sheet1")があるか、Cells(4,3)に値が入っているかだと私は思います。

 Sub SameFolderSave()
    Dim thisPath As String
    Dim newname As String

    thisPath = ThisWorkbook.Path
	Msgbox thisPath ’安易なやり方(これでも大丈夫)
	'Debug.Print newname ’正しいやり方
    newname = Sheets("Sheet1").Cells(4, 3).Value
    	Msgbox newname     
	Msgbox thisPath & "\" & newname & ".xlsm"
        Exit Sub
    ThisWorkbook.SaveAs FileName:=thisPath & "\" & newname & ".xlsm"
 End Sub

 次のステップの参考ページ
 http://officetanaka.net/excel/vba/file/file09.htm
( NN ) 2018/03/14(水) 00:07

γさん、NNさん、早速のご教示ありがとうございました。

勤務の関係で、ご教示を元に確認することが、すぐにはできません。
確認し、状況を改めてお知らせするとともに、新たな問題が生じた場合には
改めて質問させていただきます。
そのときは、ご迷惑でもご教示の程、よろしくお願いいたします。
(あらいぐま) 2018/03/14(水) 06:47


γさん、NNさん、恥ずかしい原因に気づきました。

ブック内のマクロ記述が本掲示板に挙げたものと違っていました。
それは、「=thisPath & "\" & newname & ".xlsm"」の部分が
「=thisPath & ""\" & newname & ".xlsm"」となっていました。

訂正しましたら、期待通りの動作をしてくれました。
また、NNさんのものも、確認を要求しながら動作してくれました。
本当にありがとうございました。

(あらいぐま) 2018/03/14(水) 16:10


いらぬお節介かもしれませんが、
・Sheet1のC3セルがブランクでも進んでしまい、途中でエラーになるような気がする。
・拡張子をxlsmにするだけでは、マクロ付きブック形式で保存されないという噂を聞いたことがある。
という観点からちょっと修正してみました。
上のどちらかが原因で困ってしまったときの研究材料として使ってください。

Sub Sample()
'==変数の宣言とか

    Dim buf As String

'==処理

    With ThisWorkbook
        buf = .Worksheets("Sheet1").Cells(4, 3).Value = ""

        If buf = "" Then
            MsgBox "処理失敗"
            Exit Sub
        Else
            .SaveAs _
                Filename:=.Path & "\" & buf & ".xlsm", _
                FileFormat:=xlOpenXMLWorkbookMacroEnabled
        End If
    End With
 End Sub
(もこな2) 2018/03/14(水) 18:52

もこな2さん、追加のご教示ありがとうございます。
研究材料にとのこと、困ったときに活用させていただきます。
(あらいぐま) 2018/03/14(水) 21:10

 まだ見られていましたか!!
 Mr.TANAKAのページは参考になりましたか?
 私は古いタイプなので、はるか昔にどこかのホームページを見て
 フォルダ名を取得したら直後に念のために次の一行を必ず入れるようにしています。
 (最近は必要無いのですが、 以前は何かの時に必要なケースがあったような気がしています。)
   If Right$(thisPath, 1) <> "\" Then thisPath= thisPath & "\"
 後の作業で"\"を気にすることなくファイル名が扱えるのも良い点だと思って使っています。
( NN ) 2018/03/15(木) 01:02

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.