【ExcelVBA】マクロブックを通常のエクセルブックとして保存する方法？

Question

Office365です。
現在開いているマクロブックの
「一番左にある1シート」もしくは「〇〇〇〇という特定の名称シート」のみを、
.xlsx(マクロなしブック)として保存するにはどのような処理になるのでしょうか？
その時の保存先は、
「今開いているマクロブックと同じ場所(フォルダ)」または「今開いているユーザのデスクトップ」に
したいです。(つまりどのユーザが操作しても統一された挙動となる)
シート名をファイル名にし、末尾に保存した瞬間の日時が入って、複数回実行した時に重複しないようにしたいです。
〇〇〇〇というシート名だったとして、現在2021年3月22日18時56分だっとしたら、
〇〇〇〇_20210322_1856.xlsx としたいです。
ただ不明点は、該当シートには、マクロ実行用のフォームボタンが設置されており、
それを削除出来た方がスマートなのにと思ってます。

Qchan1962 · Accepted Answer

取敢えず、今のロジックを変えない場合は、こんな感じでどうでしょう。
ちなみに、メモリースタックするようでしたら、ロジック自体変えた方が良いかもしれません。

Sub Sample2()
    Dim FolPath As String
    Dim NewBK_name As String
    Dim obj As Button
    FolPath = CreateObject("WScript.Shell").SpecialFolders("desktop")
    NewBK_name = Sheets(1).Name & "_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss")
    Application.ScreenUpdating = False
    Sheets(1).Copy
    With ActiveWorkbook
        Application.DisplayAlerts = False
        .SaveAs FolPath & "\" & NewBK_name & ".xlsx", FileFormat:=51
        Application.DisplayAlerts = True
        .Worksheets(1).UsedRange.Value = .Worksheets(1).UsedRange.Value
        For Each obj In .Worksheets(1).Buttons
            obj.Delete
        Next
        .Close SaveChanges:=True
    End With
    Application.ScreenUpdating = True
End Sub

他に削除するものが無く、フォームボタンすべてを消すなら、
’＃４　fujillin様のコードがスマートと思いますのでActiveSheet.Buttons.Delete　で

Qchan1962 · Answer

こんばんは、
なんか意地悪したみたいでごめんなさい。
自身で考える事や試す事がプログラムを作ろ時の面白さと言うか、醍醐味です。出来たものを試すだけだと、好奇心や探究心は生まれず、私の様に趣味でVBAをこさえる輩を理解でき、、、いやいや理解してもらいたい訳では無いのですが、少しうれしくて。。

本題です。
列や行を削除するコードは、
Columns(2).DeleteやColumns("B").Deleteなどとなります。
他にも.EntireColumnを使ってRange("B1").EntireColumn.Delete
この場合明示したセルを含む（がある）列が対象になります。
（.EntireColumnを使うのはCellsで指定している場合やRangeオブジェクト変数で範囲を指定している場合などが多いです）
更にRangeを使用する場合だとRange("B:B").Delete 
これがむしろわかり易いかも知れません。

行に関しては、同様に Columns部分がRowsに代わるだけです。

記録マクロで考えてみましょう。
私も記録マクロは今でも使います。メソッドが記録できるか、プロパティなど、デフォルトなどの確認に使います。

最初に記録マクロを整理するヒントです。これも最初に覚えた事です。

言葉で書くと　例えば、

私はテーブルのお皿にあるりんごを選んで、選んでいるそれを食べました

どこにあるりんごなのかは、とても大切な事ですが、
行動（実行）として端的に考えると　
私はお皿にあるりんごを食べました。で解ります。
つまり、
Columns("B:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1").Select
選んでSelect　と　選んでいるSelectionは同じものを指しています
なので
Columns("B:D").Delete Shift:=xlToLeft
でB,C,D列が削除されます。Shift:=xlToLeftはデフォルトなので
Columns("B:D").Delete　だけでも問題なく削除され左にシフトします。

Application.CutCopyMode = False　これは何か？
これは、コピーモード、、範囲指定してコピーした時のコピー範囲点線
を解除（ESCキー）をした時に書き込まれるコードです。
今回不要と考えられます。Range("A1").Select　これは、意外に必要になる場合があります。ただし、マクロの終了時のセル選択位置を思う場所にしたい時です。　マクロ実行中のコード内には極力.Selectを行わないのが処理を早く、またわかり易くします。（例外もあります）

では、挿入場所です。（＃９の＊をよく読んで理解するようにしてください）
＃９に書かせていただいた注意点をふまえるとシート加工の最後に入れるのが良いと思います。
Nextの下の行に入れるのが良いと思います。

ここで注意点があります。
With ActiveWorkbookの中でActiveWorkbookは新しいブックです。
そのボタンや値を操作して列を削除するのですから、
先ほどのりんごの文章にあるように　どこの（テーブルの）が大事になります。（この時ブックは2つ以上開いている状態なので）
With ActiveWorkbookの中で書かれているほかのオブジェクトの書き方を参考に
.Columns("B:D").Delete Shift:=xlToLeft 
とします。 .Columnsの前にはActiveWorkbookが省略（ちょっと違うけど）しているのと同じ事になります。

付近を書くとこんな感じ
Sheets(1).Copy
With ActiveWorkbook
Application.DisplayAlerts = False
.SaveAs FolPath & "\" & NewBK_name & ".xlsx", FileFormat:=51
Application.DisplayAlerts = True
.Worksheets(1).UsedRange.Value = .Worksheets(1).UsedRange.Value
For Each obj In .Worksheets(1).Buttons
obj.Delete
Next
.Columns("B:D").Delete Shift:=xlToLeft 
.Close SaveChanges:=True

説明べたで長文になってしまい申し訳ありません。
最後に
＃９のお礼の場所に削除コードを入れるとコピー元シートのB:D列が削除されると思うにですが、、ではありませんか。。
検証用表組みになっていて確認しにくくなっているのでは無いかと思いますがどうでしょう。

Qchan1962 · Answer

＞理想通りに動きました。
良かったです。
.Worksheets(1).UsedRange.Value = .Worksheets(1).UsedRange.Value
の下の行にカラムを削除するコードを入れれば出来ると思います。
「B列、C列、D列」と連続したカラムなら1行コードだと思います。
カラム削除コードは、多分ご存知かと思いますが、調べてみてくださいね。

＊フォームボタン以外のシェイプ、グラフなどがありセルに合わせてサイズを変更するなどとしている場合、サイズが変更される可能性があります。
また、.Worksheets(1).UsedRange.Value =　の前にカラム削除を実行した場合、削除される列を参照している関数の解がエラーになるので注意が必要だと思います。
作り甲斐をすべて奪いたくないので、すみません。あしからず。

Qchan1962 · Answer

Application.DisplayAlerts = False　を言いたかっただけです

＞ボタンが2つ配置してあって、右側だけ消すみたいなのも出来るのでしょうか？
たとえば、左のボタンがA1セルにかかっている場合は、こんな感じで残せますと言う例でした。。
失礼しました。

Qchan1962 · Answer

ちなみに
よく考えると保存するシートモジュールにマクロが記載されている場合、
アラートが出力されるので、抑制が必要になりますね。

Dim obj As Button
    With ActiveWorkbook
        Application.DisplayAlerts = False
        .SaveAs FolPath & "\" & NewBK_name & ".xlsx", FileFormat:=51
        Application.DisplayAlerts = True
        For Each obj In .Worksheets(1).Buttons　’フォームボタン
            If obj.TopLeftCell.Address(0, 0) <> "A1" Then
                obj.Delete
            End If
        Next
        .Close SaveChanges:=True
    End With
ボタンの左上がA1セルにかかっているボタンは削除されません。

Qchan1962 · Answer

>では、ボタンが2つ配置してあって、右側だけ消すみたいなのも出来るのでしょうか？
>その時はボタンを特定する何かが必要になりますよね？？？

ボタンを特定する方法は、いくつかあります。
すべてでないので　For Each などで処理する必要がありますが

インデックスが分かっていれば、インデックスで対象又は対象から外す。
同様にオブジェクトの名前が分かっていれば、名前で、

更に配置が分かっていれば、If obj.TopLeftCell.Address ・・みたいに
配置アドレスなどを取得して　処理するとか、、、色々考えられますね。

fujillin · Answer

こんばんは

すでに回答が出ていますが、ご参考までに。
（フォームボダン限定で削除しています。ActiveXボタンは残ります）

Sub sample_12270179()
Dim n

n = Worksheets(1).Name & Format(Date, "_yyyymmdd") & Format(Time, "_hhmmss") & ".xlsx"
Worksheets(1).Copy
ActiveSheet.Buttons.Delete
ActiveWorkbook.SaveAs CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & n
ActiveWorkbook.Close False
End Sub

Qchan1962 · Answer

まずいです。本当に申し訳ない。
＃２について
obj.Delete、、図形なども消してしまいますね。

下記に修正してみてください。
 For Each obj In .Worksheets(1).Shapes
            If obj.Type = 8 Then
                obj.Delete
            End If
        Next

8　は、msoFormControl　です。
もし、ActiveXコントロールを使用している様でしたら
　obj.Type = 12　　又は　or で

更にフォームボタン限定なら、
Dim obj　’宣言を書き換えて
 For Each obj In .Worksheets(1).Buttons
obj.Delete
Next

で行けるかと、、、連投すみません。

Qchan1962 · Answer

＃１です
ごめんなさい。
＞ただ不明点は、該当シートには、マクロ実行用のフォームボタンが設置されており、それを削除出来た方がスマートなのにと思ってます。

追加しました。。
Sub Sample2()
    Dim FolPath As String
    Dim NewBK_name As String
    Dim obj As Shape
    FolPath = CreateObject("WScript.Shell").SpecialFolders("desktop")
    NewBK_name = Sheets(1).Name & "_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss")
    Application.ScreenUpdating = False
    Sheets(1).Copy
    With ActiveWorkbook
        .SaveAs FolPath & "\" & NewBK_name & ".xlsx"
        For Each obj In .Worksheets(1).Shapes
            obj.Delete
        Next
        .Close SaveChanges:=True
    End With
    Application.ScreenUpdating = True
End Sub

Qchan1962 · Answer

こんばんは、
よくある処理なので取敢えず実行コードを書きます。
内容をデバッグして確認してくださいね。
サンプルは、一番左にある1シート　にしました。
理由は、必ずあるからです。特定名称の場合、見つからない場合の処理が必要になりますので、悪しからず。

Sub Sample1()
    Dim FolPath As String
    Dim NewBK_name As String
    FolPath = CreateObject("WScript.Shell").SpecialFolders("desktop")
    NewBK_name = Sheets(1).Name & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss")
    Application.ScreenUpdating = False
    Sheets(1).Copy
    ActiveWorkbook.SaveAs FolPath & "\" & NewBK_name & ".xlsx"
    ActiveWorkbook.Close
    Application.ScreenUpdating = True
End Sub

試していないので、コピーブックなどでテストしてください。

【ExcelVBA】マクロブックを通常のエクセルブックとして保存する方法？

取敢えず、今のロジックを変えない場合は、こんな感じでどうでしょう。

こんばんは、

＞理想通りに動きました。

Application.DisplayAlerts = False を言いたかっただけです

ちなみに

>では、ボタンが2つ配置してあって、右側だけ消すみたいなのも出来るのでしょうか？

こんばんは

まずいです。

＃１です

こんばんは、

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

Application.DisplayAlerts = False　を言いたかっただけです