[[20200910171657]] 『自動保存で上書きされないようにしたい2』(96) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『自動保存で上書きされないようにしたい2』(96)

http://www.excel.studio-kazu.jp/kw/20200829163928.htmlで教えていただいたマクロを使ってみたのですが、こう出来たりしないかな?というのが出てきたので教えていただきたいです。

.
日付はいれず、「得意先様 〇〇〇_00」といった形で、番号のみにしたいです。
下記のように変えてみて、保存二回目から「_01」、「_02」...とつくように出来ました。
これを保存1回目で「_01」とつけたいのですが出来たりしますでしょうか?

***

Sub PDF_2編集()

 Dim i As Long
 Dim myfol As String
 Dim mysavepath As String
 Dim saveflag As Boolean

myfol = "\\保存先\" '保存先フォルダ
mysavepath = myfol & "\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AP1").Value & ".pdf" '保存パス
If Dir(mysavepath) <> "" Then '保存パスが存在したら
saveflag = False 'フラグを立てFALSEを代入
i = 0 'カウンタの初期化
Do Until saveflag = True 'フラグがFALSEの間はループする
i = i + 1 'カウントアップ
mysavepath = myfol & "\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AP1").Value & "_" & Format(i, "00") & ".pdf" '保存パスの再指定
If Dir(mysavepath) <> "" Then ' 保存パスが存在したら
saveflag = False 'フラグをFALSEにする
Else '保存パスが存在しなかったら
saveflag = True 'フラグをTRUEにする/ループを抜ける

      End If
     Loop 'ループ
End If

'PDF保存実行
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mysavepath, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

***

.
.
.
もう一点、上記の動作に追加でしたいことがあります。

PDF保存と同時に、同じデータ名(「得意先様 〇〇〇_00」)で、原本とは別のマクロが有効なExcelファイルを保存したいです。
やりたい動作自体は下記で出来たのですが、1つ目の質問のマクロとの組み合わせ方がわかりません。

下記は、「得意先様 〇〇〇 NO.("AX1")」と伝票番号みたいなのを付けることで上書きされないようにして行ったものです。

***

Sub PDF()

'Excelデータを保存
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
ChDir "\\LS-WXBL092\share\青木\発注書\Excelデータ"
ActiveWorkbook.SaveAs Filename:="\\保存先2\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AN1").Value & " No." & ActiveSheet.Range("AX1").Value & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close

'PDFで名前を付けて保存
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\保存先\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AN1").Value & " No." & ActiveSheet.Range("AX1").Value, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub

< 使用 Excel:Excel2019、使用 OS:Windows10 >


こちらで質問をしたことで整理されたのか、2つ目の質問は下記のような感じでやりたいことが出来ました。
...無駄な点とかありましたらご指摘願えたらと思います。

1つ目の質問「保存1回目で「_01」とつけたい」というのを下記の動作を行える状態でやりたいです。
どうぞよろしくお願いいたします。

***

Sub PDF_3編集()

Dim i As Long
Dim myfol As String
Dim mysavepath As String
Dim saveflag As Boolean

myfol = "保存先2\" '保存先フォルダ
mysavepath = myfol & "\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AP1").Value & ".xlsm" '保存パス
If Dir(mysavepath) <> "" Then '保存パスが存在したら
saveflag = False 'フラグを立てFALSEを代入
i = 0 'カウンタの初期化
Do Until saveflag = True 'フラグがFALSEの間はループする
i = i + 1 'カウントアップ
mysavepath = myfol & "\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AP1").Value & "_" & Format(i, "00") & ".xlsm" '保存パスの再指定
If Dir(mysavepath) <> "" Then ' 保存パスが存在したら
saveflag = False 'フラグをFALSEにする
Else '保存パスが存在しなかったら
saveflag = True 'フラグをTRUEにする/ループを抜ける

     End If
     Loop 'ループ
End If
'Excel保存実行
Sheets("Sheet1").Select
Sheets("Sheet1").Copy
ChDir "\\LS-WXBL092\share\青木\発注書\Excelデータ"
ActiveWorkbook.SaveAs Filename:=mysavepath _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
Range("AQ6").Select

myfol = "\\保存先\" '保存先フォルダ
mysavepath = myfol & "\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AP1").Value & ".pdf" '保存パス
If Dir(mysavepath) <> "" Then '保存パスが存在したら
saveflag = False 'フラグを立てFALSEを代入
i = 0 'カウンタの初期化
Do Until saveflag = True 'フラグがFALSEの間はループする
i = i + 1 'カウントアップ
mysavepath = myfol & "\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AP1").Value & "_" & Format(i, "00") & ".pdf" '保存パスの再指定
If Dir(mysavepath) <> "" Then ' 保存パスが存在したら
saveflag = False 'フラグをFALSEにする
Else '保存パスが存在しなかったら
saveflag = True 'フラグをTRUEにする/ループを抜ける

      End If
     Loop 'ループ
  End If
'PDF保存実行
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mysavepath, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End Sub
(96) 2020/09/10(木) 18:01


 >日付はいれず、「得意先様 〇〇〇_00」といった形で、番号のみにしたいです。 
 >下記のように変えてみて、保存二回目から「_01」、「_02」...とつくように出来ました。 
 >これを保存1回目で「_01」とつけたいのですが出来たりしますでしょうか? 

 ↓のように一部をコメントアウトすればお望みの形になります。
 「'/コメントアウト」が付いた部分をコメントアウトするか削除します。
 ※コメントアウト以外はコードはそのままです。

Sub PDF_2編集_2()

 Dim i As Long
 Dim myfol As String
 Dim mysavepath As String
 Dim saveflag As Boolean
  myfol = "\\保存先\" '保存先フォルダ 
  'mysavepath = myfol & "\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AP1").Value & ".pdf" '保存パス  '/コメントアウト
  'If Dir(mysavepath) <> "" Then '保存パスが存在したら '/コメントアウト
     saveflag = False 'フラグを立てFALSEを代入 
     i = 0 'カウンタの初期化 
     Do Until saveflag = True 'フラグがFALSEの間はループする 
       i = i + 1 'カウントアップ 
       mysavepath = myfol & "\" & ActiveSheet.Range("A7").Value & "様" & " " & ActiveSheet.Range("AP1").Value & "_" & Format(i, "00") & ".pdf" '保存パスの再指定 
       If Dir(mysavepath) <> "" Then ' 保存パスが存在したら 
          saveflag = False 'フラグをFALSEにする 
       Else '保存パスが存在しなかったら 
          saveflag = True 'フラグをTRUEにする/ループを抜ける 
       End If
     Loop 'ループ
  'End If '/コメントアウト

  'PDF保存実行 
  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=mysavepath, Quality:=xlQualityStandard, _ 
   IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True 
End Sub 
(OK) 2020/09/11(金) 18:00

 ↑のコードは「Sub PDF_3編集() 」は反映されてませんのでご注意。
 改造版ができたらアップするかもしれません。
(OK) 2020/09/11(金) 18:03

OK様

再びのご教授ありがとうございます。

「Sub PDF_3編集() 」の方でExcelへの保存・PDFへの保存両方にコメントアウトを入れて実行してみたところ、無事に両方とも_01から保存が出来ました。

理解が足りず、申し訳ないです。
ありがとうございました。
(96) 2020/09/14(月) 16:25


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.