0

Excel 2010 を使用しており、次のマクロを使用しようとしています。

  1. 名前を付けて保存ダイアログボックスを開く
  2. 最初のファイル名を取得し、ファイル タイプ (つまり .xlsx) の前にアンダースコアの後に 8 つの連続した整数 (つまり _12345678) があるかどうかを確認します。
  3. それが存在する場合は、削除してアンダースコアに置き換え、その後にファイルタイプ (.xlsx) の前に「yyyymmdd」形式 (つまり、_20130730) の今日の日付を続けます。
  4. それが存在しない場合は、ファイルの種類 (つまり .xlsx) の前にアンダースコアとそれに続く "yyyymmdd" 形式 (つまり _20130730) の今日の日付を追加するだけです。
  5. 上記の基準に基づく新しいファイル名は、開いている [名前を付けて保存] ダイアログ ボックスの [ファイル名] フィールドに表示されますが、ユーザーは実際にファイルを保存する必要があります (名前を付けて [名前を付けて保存] を開くだけです。実際に VBA で保存するわけではありません)。
  6. 元のファイルの種類が何であれ維持する

今日の日付が2013 年7 月 30日であると仮定すると、マクロは次の開始ファイルに対して次のように動作します
。.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 に答える