| 
    
     |  | 詳細にありがとうございます。 流れを見て修正し、PDF保存まではできたものの、やはり(1)…と追加するところで手詰まりになってしまいます。
 
 Dim k As Integer が抜けていたことが原因かと思ったのですが見当違いでしょうか…。
 
 
 Dim Desktop_Path As String
 Dim k As Integer
 '****デスクトップのパス取得
 Desktop_Path = CreateObject("WScript.Shell").SpecialFolders.Item("Desktop")
 
 
 '''保存しようとしたファイル名と既に同じファイル名が存在するならば、
 '''ファイル名の末尾に(i)をつける
 If Dir(Desktop_Path) <> "" Then
 '保存ファイル名を取得
 fileSaveName_name = Dir(Desktop_Path)
 '保存先のフォルダを取得
 Desktop_Path_path = Replace(fileSaveName, Desktop_Path_name, "")
 
 '保存ファイル名の末尾に(i)をつける
 k = 1
 Do While Dir(Desktop_Path) <> ""
 fileSaveName = Desktop_Path_path & Replace(Desktop_Path_name, ".pdf", "") & "(" & k & ")" & ".pdf"
 k = k + 1
 Loop
 End If
 '****アクティブシートをPDFファイルとして保存(デスクトップにA1セルに入力されている名前を付けて保存)
 With ActiveSheet
 .ExportAsFixedFormat _
 Type:=xlTypePDF, _
 Filename:=Desktop_Path & "\" & "" & .Range("AI1").Value & ".pdf"
 End With
 
 |  |