0

我正在使用 Excel 2010，并尝试将宏用于以下操作：

  1. 打开另存为对话框
  2. 取初始文件名并检查文件类型（即.xlsx）前是否有下划线后跟8个连续整数（即_12345678）
  3. IF that DOES EXIST 将其删除并替换为文件类型（即.xlsx）之前的“yyyymmdd”格式（即_20130730）的今天日期
  4. 如果不存在，只需在文件类型（即.xlsx）之前添加一个下划线，后跟今天的日期，格式为“yyyymmdd”（即_20130730）
  5. 基于上述条件的新文件名将出现在打开的另存为对话框的文件名字段中，但文件将要求用户实际保存它（只是命名和打开另存为。实际上不使用 VBA 保存）
  6. 保持原始文件类型是什么

假设今天的日期是 2013 年 7 月 30 日，宏将对以下起始文件按如下方式工作：
1.)测试文件 A_20130615.xlsx将变为测试文件 A_20130730.xlsx
2.)测试文件 B.xlsx将变为测试文件 B_20130730 .xlsx

任何和所有的帮助表示赞赏！谢谢

4

1 回答 1

2

我修改了一个例程，它执行您尝试执行的相同类型的操作，但使用文件的当前名称，而不是有 2 个保存对话框。

Option Explicit

Function SaveIt()

Dim CurrentFile As String
Dim FileExt As String
Dim GetFileName

CurrentFile = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, ".") - 1)
FileExt = Mid(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, "."))

If InStr(CurrentFile, "_") Then
    'has underscore
    If InStrRev(CurrentFile, "_") = Len(CurrentFile) - 8 Then
        ' underscore 8 from end
        If Right(CurrentFile, 8) = CStr(Val(Right(CurrentFile, 8))) Then
            ' and it's 8 digits at the end
            CurrentFile = Left(CurrentFile, Len(CurrentFile) - 9)
            'strip the end off
        End If ' if it fails any of these tests,
    End If  'then it's not got the underscore and date
End If ' and we don't touch the filename

CurrentFile = CurrentFile & "_" & Format(Now, "yyyymmdd")

GetFileName = Application.GetSaveAsFilename(CurrentFile & FileExt)

If GetFileName <> False Then 'Cancel returns false, otherwise it returns the filename
    ActiveWorkbook.SaveAs GetFileName
End If

End Function

这也允许人们拥有名为test_1.xlsx和What_a_lot_of_underscores.xlsm的文件，而不必担心会破坏名称

于 2013-07-30T17:04:39.287 回答