【フリーコード】Wordでコピーを保存

MS標準の「名前をつけて保存」だと「保存後のファイル」で編集が継続されてしまうが、こちらのマクロだと、コピーを保存した上で、元のファイルの編集を継続することができます。

Sub コピーを保存()
'まずは変数を定義する!
  Dim path As String
  Dim docName As String, docName2 As String
  Dim cursorNumS As Long, cursorNumE As Long
  path = ActiveDocument.path '現在ファイルのpathを取得
  docName = ActiveDocument.Name '現在ファイル名を取得
  docName2 = Left(docName, InStrRev(docName, ".") - 1) '現在ファイル名の拡張子なしを取得
'現在のカーソル位置を記憶しておく
  cursorNumS = Selection.Start
  cursorNumE = Selection.End
'全選択(ヘッダとフッタを含む)
  Selection.WholeStory
'コピー
  Selection.Copy
'新規の白紙ページを開く
  Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
'ペースト
  Selection.Paste

'コピーのファイル名
  strDocName = path & "\" & docName2 & "_" & Format(Now, "yyyymmddhhmm") & ".docx"
'コピーを保存
  ActiveDocument.SaveAs2 FileName:=strDocName
  ActiveWindow.Close DoNotSave
'カーソルを戻す
  Selection.Start = cursorNumS
  Selection.End = cursorNumE
End Sub

こちらはWordのソースですが、Excelでも少し修正すれば同じことができます。


この記事が気に入ったらサポートをしてみませんか?