[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『自動保存で上書きされないようにしたい2』(96)
http://www.excel.studio-kazu.jp/kw/20200829163928.htmlで教えていただいたマクロを使ってみたのですが、こう出来たりしないかな?というのが出てきたので教えていただきたいです。
.
日付はいれず、「得意先様 〇〇〇_00」といった形で、番号のみにしたいです。
下記のように変えてみて、保存二回目から「_01」、「_02」...とつくように出来ました。
これを保存1回目で「_01」とつけたいのですが出来たりしますでしょうか?
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")」と伝票番号みたいなのを付けることで上書きされないようにして行ったものです。
'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 >
1つ目の質問「保存1回目で「_01」とつけたい」というのを下記の動作を行える状態でやりたいです。
どうぞよろしくお願いいたします。
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
再びのご教授ありがとうございます。
「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.