主页 / 问题 / 1588428
Accepted
Светлана
Asked:2024-07-26 15:43:30 +0000 UTC2024-07-26 15:43:30 +0000 UTC

如何为保存的 VBA Excel 文档指定唯一的名称。例如测试0、测试1等。

  • 772
Public Sub ButtonSave_Click()
Workbooks.Add
FiNum = 0
FiName = "C:\Users\svv71\Desktop\Test\Test" & FiNum & ".xlsx"
ActiveWorkbook.SaveAs Filename:=FiName
FiNum = FiNum + 1

ActiveWorkbook.Close
End Sub
vba

2 个回答

  1. Best Answer

    像那样：

    Sub sxfgsdf()
  Dim FiNum As Integer, FiName As String
  FiName = "C:\Users\svv71\Desktop\Test\Test"
  While Dir(FiName & FiNum & ".xlsx") <> ""
    FiNum = FiNum + 1 ' циклим и инкрементируем, пока такой файл есть
  Wend
  ActiveWorkbook.SaveAs Filename := FiName & FiNum & ".xlsx"
End Sub

    如果您需要一个唯一的名称，那么您需要将其保存在书中的某个位置。您可以创建一个新的杂项表（例如）并将其隐藏。

    Sub sxfgsdf()
  Dim FiNum As Integer, FiName As String
  FiName = "C:\Users\svv71\Desktop\Test\Test"
  FiNum = Sheets("Misc").Cells(1, 1) + 1
  While Dir(FiName & FiNum & ".xlsx") <> ""
    FiNum = FiNum + 1 ' циклим и инкрементируем, пока такой файл есть
  Wend
  Sheets("Misc").Cells(1, 1) = FiNum ' счётчик будет в последней сохранённой книге
  ActiveWorkbook.SaveAs Filename := FiName & FiNum & ".xlsx"
End Sub

    计数器可以自主存储在单独的文件中。

    • 0

  2. 使用CustomDocumentProperties 的选项

    Option Explicit

Sub UniqNameSave()
    Const CDP_NAME = "Version", BASE_NAME = "Test*.xlsx"
    Dim Version As Object
    With ActiveWorkbook.CustomDocumentProperties
        On Error Resume Next
        Set Version = .Item(CDP_NAME) ' пытаемся извлечь свойство с номером версии книги
        On Error GoTo 0
        If Version Is Nothing Then ' если свойства еще нет, то добавляем его и устанавливаем начальное значение
            .Add Name:=CDP_NAME, LinkToContent:=False, Type:=msoPropertyTypeNumber, Value:=0
        Else
            Version = Version + 1 ' если свойство уже существует, инкрементируем
        End If
        ActiveWorkbook.SaveAs Replace(BASE_NAME, "*", Format(Version, "000")) ' сохраняем книгу, добавляя номер версии из свойства и форматируя
    End With
End Sub

    Test016.xlsx
Test015.xlsx
Test014.xlsx
Test013.xlsx
Test012.xlsx
...
    • 0

相关问题