| |
なるべく元コードを生かすようにして書き換えました。
Sub test()
'名前をつけて保存
Dim Desktop_Path As String
Dim fileSaveName As String
Dim fileSaveName_Name As String
Dim fileSavePath As String
Dim kaku As String
Dim ws As Worksheet
Set ws = ActiveSheet
kaku = "pdf"
Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
fileSaveName = ws.Range("AI1").Value
fileSaveName_Name = fileSaveName
fileSavePath = Desktop_Path & "\" & fileSaveName_Name & "." & kaku
'''保存しようとしたファイル名と既に同じファイル名が存在するならば、
'''ファイル名の末尾に(i)をつける
If Dir(fileSavePath) <> "" Then
k = 0
Do While Dir(fileSavePath) <> ""
k = k + 1
'保存ファイル名を取得
fileSaveName_Name = fileSaveName & Format(k, "(0)")
fileSavePath = Desktop_Path & "\" & fileSaveName_Name & "." & kaku
Loop
End If
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fileSavePath
Set ws = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
