Diminta oleh saran dari @Adam dan @ Lưu Vĩnh Phúc, saya membuat makro berikut yang melakukan apa yang Anda minta. Perhatikan bahwa ini akan menghapus riwayat apa pun yang terkait dengan file.
Sub RenameActiveFile()
'
' Renames the current file without closing the document (assuming file has already been saved)
' (Actually, saves with new name and deletes previous, so history will be lost).
'
Dim strFileFullName, strFileName, strNewName As String
Dim res As VbMsgBoxResult
' Get current name:
strFileFullName = ActiveDocument.FullName 'for Word docs
'strFileFullName = ActiveWorkbook.FullName 'for Excel docs
'strFileFullName = Application.ActivePresentation.FullName 'for Powerpoint presentations*
If (InStr(strFileFullName, ".") = 0) Then
res = MsgBox("File has not been saved. Can't rename it.", , "Rename File")
Exit Sub
End If
strFileName = Right(strFileFullName, Len(strFileFullName) - InStrRev(strFileFullName, "\")) 'strip path
strFileName = Left(strFileName, (InStr(strFileName, ".") - 1)) ' strip extension
' Prompt for new name:
strNewName = InputBox("Rename this file to:", "Rename File", strFileName)
If (strNewName = "") Or (strNewName = strFileName) Then ' (Check whether user cancelled)
Exit Sub
End If
' Save file with new name:
ActiveDocument.SaveAs2 FileName:=strNewName 'for Word docs
'ActiveWorkbook.SaveAs2 FileName:=strNewName 'for Excel docs
'Application.ActivePresentation.SaveAs FileName:=strNewName 'for Powerpoint presentations*
' Delete old file:
With New FileSystemObject ' (this line requires: Tools->References->Microsoft scripting runtime)
If .FileExists(strFileFullName) Then
.DeleteFile strFileFullName
End If
End With
End Sub
* Catatan: meskipun makro ini berfungsi dengan Powerpoint (dengan modifikasi yang disebutkan di atas), PowerPoint tidak dapat menyimpannya secara global .