VBAファイルを保存するためのExcelコード

Question

別のコードを試しましたが、正しい出力が得られません。私は、ファイルの場所を選択できるコードが必要です。すべての作業、私は保存するときに選択されたファイルの場所にPNGを保存する必要があります。私は次のものしか持っていません：

FName = "C:\Users\Desktop\Nutrifacts and Analysis-Save\1.png" 

Sub picsave_Click() 

Dim pic_rng As Range 
Dim ShTemp As Worksheet 
Dim ChTemp As Chart 
Dim PicTemp As Picture 
Dim FName As String 


FName = "C:\Users\Desktop\Nutrifacts and Analysis-Save\1.png" 



Application.ScreenUpdating = False 

ThisWorkbook.Windows(1).DisplayGridlines = False 

Set pic_rng = Worksheets(1).Range("A1:R31") 
Set ShTemp = Worksheets.Add 
Charts.Add 
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name 
Set ChTemp = ActiveChart 
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture 

With ThisWorkbook.Sheets(1) 
ActiveSheet.Shapes.Item(1).Line.Visible = msoFalse 
ActiveSheet.Shapes.Item(1).Width = .Range("A1:R31").Width 
ActiveSheet.Shapes.Item(1).Height = .Range("A1:R31").Height 
End With 

ChTemp.Paste 
ChTemp.Export fileName:=FName, Filtername:="png" 

    Application.DisplayAlerts = False 
    ShTemp.Delete 
Application.DisplayAlerts = True 

ThisWorkbook.Windows(1).DisplayGridlines = True 

Application.ScreenUpdating = True 

Set ShTemp = Nothing 
Set ChTemp = Nothing 
Set PicTemp = Nothing 



MsgBox ("Done.") 

    End Sub 

Answer 1

以下を試してみてください。ファイル名を取得するために変数varResultが追加されました。必要に応じて変更することができます。ファイル名を取得するにはApplication.GetSaveAsFilenameを使用してください。

Sub test() 

Dim pic_rng As Range 
Dim ShTemp As Worksheet 
Dim ChTemp As Chart 
Dim PicTemp As Picture 
Dim FName As String 
Dim varResult As Variant 

On Error Resume Next 
FName = "C:\Users\Desktop\Nutrifacts and Analysis-Save\1.png" 

'displays the save file dialog 
varResult = Application.GetSaveAsFilename(FileFilter:="PNG (*.png), *.png") 
If varResult = False Then 
    Exit Sub ' do what you want 
Else 
    FName = varResult 
End If 

Application.ScreenUpdating = False 

ThisWorkbook.Windows(1).DisplayGridlines = False 

Set pic_rng = Worksheets(1).Range("A1:R31") 
Set ShTemp = Worksheets.Add 
Charts.Add 
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name 
Set ChTemp = ActiveChart 
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture 

With ThisWorkbook.Sheets(1) 
    ActiveSheet.Shapes.Item(1).Line.Visible = msoFalse 
    ActiveSheet.Shapes.Item(1).Width = .Range("A1:R31").Width 
    ActiveSheet.Shapes.Item(1).Height = .Range("A1:R31").Height 
End With 


ChTemp.Paste 
ChTemp.Export Filename:=FName, Filtername:="png" 

Application.DisplayAlerts = False 
ShTemp.Delete 
Application.DisplayAlerts = True 

ThisWorkbook.Windows(1).DisplayGridlines = True 

Application.ScreenUpdating = True 

Set ShTemp = Nothing 
Set ChTemp = Nothing 
Set PicTemp = Nothing 

MsgBox ("Done.") 

End Sub