[ExcelVBA] 名前をつけて保存的なことをしたい

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 7日目

こんなシチュエーションありませんか？
それは、マクロを実行した結果を別名で保存したい時。
しかも、ユーザー自身が保存場所を選択して、そこへ保存する場合です。


ファイルの中身をうっかり変更されてしまうのを防ぐために
読み取り専用にして使っているケースは多いと思うのですが
マクロで作成したデータを保存してもらうために
わざわざ、ユーザー自身がメニューバーのファイルにある
名前をつけて保存を選択して保存をしてもらうのはちょっぴりいまいち感でいっぱいですよね！

そこは、「保存する」ボタンを用意してあげて
プログラム側で処理してあげましょう。

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Dim FileName As String  
5.       
6.     FileName = Application.GetSaveAsFilename  
7.       
8.     If FileName <> "False" Then  
9.         ActiveWorkbook.SaveAs FileName:=FileName  
10.     End If  
11.       
12. End Sub  

Option Explicit

Sub SampleCode()
    Dim FileName As String
    
    FileName = Application.GetSaveAsFilename
    
    If FileName <> "False" Then
        ActiveWorkbook.SaveAs FileName:=FileName
    End If
    
End Sub

６行目のApplication.GetSaveAsFilenameを実行したら「名前を付けて保存」の画面が立ち上がります。
ここでキャンセルを押されるとFalseの文字列が返してきます。
なので、ファイル名を指定して保存を押した場合は、フルパスが返ってきます。
よって、フルパスの場合、ドライブ名で始まるか、ネットワーク上なら¥¥で始まるため
"False"だけの場合、キャンセルを押されたと判断できます。

８行目は、キャンセルだった場合、別名保存をしないための処理を行なっています。
９行目は、別名保存しているだけです。

また、「名前を付けて保存」の初期フォルダ位置を変更したい時は、
InitialFileNameにパスを指定すればOKです。
例えば、c:ドライブ直下の場合は以下の通り。

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Dim FileName As String  
5.       
6.     FileName = Application.GetSaveAsFilename(InitialFileName:="c:\")  
7.       
8.     If FileName <> "False" Then  
9.         ActiveWorkbook.SaveAs FileName:=FileName  
10.     End If  
11.       
12. End Sub  

Option Explicit

Sub SampleCode()
    Dim FileName As String
    
    FileName = Application.GetSaveAsFilename(InitialFileName:="c:\")
    
    If FileName <> "False" Then
        ActiveWorkbook.SaveAs FileName:=FileName
    End If
    
End Sub

ファイルのタイプを指定したい場合は、
FileFilterにファイルのタイプを指定します。

view plainprint?

1. Option Explicit  
2.   
3. Sub SampleCode()  
4.     Dim FileName As String  
5.       
6.     FileName = Application.GetSaveAsFilename(InitialFileName:="c:\", FileFilter:="画像ファイル (*.jpg),*.jpg")  
7.       
8.     If FileName <> "False" Then  
9.         ActiveWorkbook.SaveAs FileName:=FileName  
10.     End If  
11.       
12. End Sub  

Option Explicit

Sub SampleCode()
    Dim FileName As String
    
    FileName = Application.GetSaveAsFilename(InitialFileName:="c:\", FileFilter:="画像ファイル (*.jpg),*.jpg")
    
    If FileName <> "False" Then
        ActiveWorkbook.SaveAs FileName:=FileName
    End If
    
End Sub

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar