0

誰かが現在のファイルのディレクトリをループし、ファイルを検索して存在するかどうかを確認する方法を教えてください.存在しない場合は、通常どおりファイルを作成します。

基本的に、すべて保存されている「マスターテンプレート」からスライドパックを抽出できるvbaマクロがあります。ユーザーが必要なパックをクリックすると、パックが抽出され、同じディレクトリに保存されます。私の問題は、バージョン管理やファイル保護の設定がないことです。ループを実行してバージョン番号をインクリメントする方法を教えてください。

Option Explicit

Public Sub CreatePack(control As IRibbonControl)

  Dim packName As String
  Dim Count As Integer
  Select Case control.Id
    Case "packbutton_B1"
      packName = "B1"
    Case "packbutton_B2"
      packName = "B2"
    Case "packbutton_TSD"
      packName = "TSD"
  End Select

  'Note: Attempt to remove characters that are not file-system friendly
  Dim Title As String
  If ActivePresentation.Slides(1).Shapes.Count >= 9 Then
    Title = Trim(ActivePresentation.Slides(1).Shapes(9).TextEffect.Text)
    If Title = "" Then MsgBox "Warning: A project title has not been entered on Slide 1."
  Else
    Title = "(Project Title Not Known)"
    MsgBox "The title slide has been removed, the project name cannot be detected."
  End If
  Title = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Title, "/", ""), "\", ""), ":", ""), "*", ""), "<", ""), ">", ""), "|", ""), """", "")

  Dim path As String
  path = ActivePresentation.path

  If Len(Dir(path & "\" & packName & " Slide Pack - " & Title & ".pptx")) > 0 Then 'File exists

 ' If MsgBox("This will produce a pack in a separate PowerPoint file. Before extracting the pack make sure you have implemented a version number otherwise your changes maybe overwritten." & vbCrLf & vbCrLf & "Your current file will remain open, and any pending changes will not be automatically saved.", vbOKCancel, "Slide Manager - Create Pack") = vbOK Then

  MsgBox ("File exists, the file name version number will be incremented")

  CopySlidesToBlankPresentation packName

  Application.ActivePresentation.SaveAs path & "\" & packName & " Slide Pack - " & Title & Count + 1, ppSaveAsOpenXMLPresentation

  ActivePresentation.Save

  Else

  MsgBox ("This will produce a pack in a separate PowerPoint file." & vbCrLf & vbCrLf & "Your current file will remain open, and any pending changes will not be automatically saved")

  CopySlidesToBlankPresentation packName

  Application.ActivePresentation.SaveAs path & "\" & packName & " Slide Pack - " & Title, ppSaveAsOpenXMLPresentation

  ActivePresentation.Save

End If

End Sub

どんな助けでも大歓迎です！

よろしく、ベン

4

1 に答える 1

1

あなたの質問を正しく理解していれば、ループは次のようになります

Dim fileNoVersion As String
fileNoVersion = path & "\" & packName & " Slide Pack - " & Title

Dim count As Integer
count = 1
While Dir(fileNoVersion & count & ".pptx") <> ""
    count = count + 1
Wend

これは、どのファイル Version1、Version2、Version3... が存在するかをチェックし、次の未使用の番号を返します。

于 2012-07-14T13:13:50.170 に答える