Excelのマクロについて

質問

お世話になります。
当方はマクロについての知識が一切なく、皆様にご助力いただきたく存じます。

1.　指定した3つのシートを1つのPDFに変換し、ファイル名は指定したセルの値で、保存先はデスクトップ。（※社員全員が使用することを前提としています。デスクトップの任意のフォルダや既存ファイルに上書きするのではなく、新規ファイルとして保存させたいです。）

2.　今開いているExcelをそっくりそのままコピーし、ファイル名のみ指定したセルの値で、保存先はデスクトップ。（※マクロは有効にしておきたいので、xlsmの拡張子のまま保存させたいです。）

自分で色々試しましたが、出来る出来ないの差異があり困っております。
よろしくお願いいたします。

回答No.1

kkkkkm · ベストアンサー

社員全員が使用するのにデスクトップは駄目なのでは(アクセス権を全員のデスクトップに設定しないと駄目だと思いますし、デスクトップを共有するのはどうかと思います)
共有フォルダを作成してそこに保存がいいのではないでしょうか

とりあえず以下のコードはログインユーザーのデスクトップに保存します。

PDFで保存

Sheet1,Sheet2,Sheet3を
Sheet4のA1に記載されたファイル名で保存

Sub Test()
Dim wsh As Object
Dim PdfName As String

PdfName = Sheets("Sheet4").Range("A1").Value

Set wsh = CreateObject("WScript.Shell")

Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
wsh.SpecialFolders("Desktop") & "\" & PdfName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set wsh = Nothing
End Sub

今開いているファイルを
Sheet4のA1に記載されたファイル名で保存

Sub Test2()
Dim wsh As Object
Dim FileName As String

FileName = Sheets("Sheet4").Range("A1").Value
Set wsh = CreateObject("WScript.Shell")

ThisWorkbook.SaveAs wsh.SpecialFolders("Desktop") & "\" & FileName & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled

Set wsh = Nothing

End Sub

お礼

大変助かりました、ありがとうございます。動作も問題なかったです。また機会がありましたらどうぞよろしくお願いいたします。

回答No.2

kkkkkm

No1の補足です。

今開いているファイルを保存はこちらがいいかも

Sub Test2()
Dim wsh As Object
Dim FileName As String, ThisFile As String

ThisFile = ThisWorkbook.Path & "\" & ThisWorkbook.Name
FileName = Sheets("Sheet4").Range("A1").Value
Set wsh = CreateObject("WScript.Shell")

ThisWorkbook.SaveAs wsh.SpecialFolders("Desktop") & "\" & FileName & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
ThisWorkbook.SaveAs ThisFile, FileFormat:=xlOpenXMLWorkbookMacroEnabled

Set wsh = Nothing

End Sub

お礼

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