ユーザーフォームでチェックしたシートを保存する方法

質問

「台帳」というExcelのブックに「リスト」「印刷用１」「印刷用２」「印刷用３」…というように複数のシートがあります。「印刷用１」…はVLOOKUP関数を用いて「リスト」に入力したデータを参照しています。
現在ユーザーフォームを用いてチェックを入れたシートを出力できるようになっているのですが、このユーザーフォームを利用してチェックを入れたシートをリンクを外した状態で１つのブックとして保存させる方法はないでしょうか？
詳しく言うと、例えば「印刷用１」「印刷用３」をコピーして新しいブック（ファイル）を作成し、シート名はそのまま維持してファイル名は「A1」セル（全シート共通です）の内容に、加えてVLOOKUP関数で取得しているデータはリンクを外してテキストに変換し、現在のフォルダに保存するという作業をVBAを使用して自動化させたいのです。（上司の要望です）
もともとあるユーザーフォームは前任者が作成したもので、当方はVBAは用語もろくにわからない全くの初心者ですので、詳しい解説も添えていただけると勉強にもなり非常に助かります。
よろしくお願いいたします。

回答No.13

kkkkkm · ベストアンサー

> 今現在「台帳」が保存されている同じフォルダ内の「ブック」というフォルダをブックの保存先として指定できる

マクロを実行しているブックのフォルダは
ThisWorkbook.Path
で求めることができますので
標準モジュールに作っていただいた
Function MacroX内にあるC:\testフォルダを指定している部分2か所を以下のように変更してください。
これと↓
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\ブック\" & MyFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled

↓こちらです
Workbooks(MyFileName).BreakLink Name:=ThisWorkbook.Path & "\Book1.xlsm", Type:=xlExcelLinks
上記は、Vlookupのリンク先がこのマクロを実行しているファイルでしたら
Workbooks(MyFileName).BreakLink Name:=ThisWorkbook.FullName, Type:=xlExcelLinks
でいけます。

ただ、あいまいで古い記憶なのですが、あまりに階層が深い場合、エラーになったような気がします。ドライブからそれぞれのフォルダ名の文字とフォルダ間の\も含めて半角文字は1文字全角文字は2文字と数えて256文字以内という規定があって、たぶん今はいけると思いますが、そのあたりがちょっと不明です。

お礼

kkkkkm様

ご返答が遅くなり申し訳ありません。
ご指摘の通りにコードを書き換えた結果、希望通りにファイルを作成・保存することができました。
また、階層の深さの件は上司に相談し、サーバーをメンテナンスする際にできるだけ上の階層になるようにして貰うことになりました。

kkkkkm様には、要領を得ない質問に根気よく回答して頂き、非常に感謝しております。
また、今回の件でマクロ作成の流れがなんとなく解ったような気がしますので、今後コードの使い方等を覚えて自分なりに色々なことを試してみようと思います。
またご助力をお願いすることがあるかもしれませんが、その際はよろしくお願いいたします。
長い期間、本当にありがとうございました。

回答No.12

kkkkkm

No11です

No11で訂正してもエラーになる場合、その状態で最初のシートがコピーされたファイルが開いている状態で止まっていると思いますので、エラーになっているマクロを停止して、新しい方のファイルで「マクロの記録」をして、名前を付けて保存時にファイルの種類をExcelマクロ有効ブック(*.xlsm)で適当なファイル名にて保存し、記録したマクロを見てください。
以下のようなものになっていると思います。
ActiveWorkbook.SaveAs Filename:="C:\test\ファイル名.xlsm",以下色々
この後ろに色々ついてるそれを
ActiveWorkbook.SaveAs Filename:="C:\test\" & MyFileName
の後ろにすべてつけてみてください。
後ろは「,」から始まります。2行以上になっている場合は
ActiveWorkbook.SaveAs Filename:="C:\test\ファイル.xlsm", FileFormat:= _
のような感じで行の最後に「 _」がつきますので、その次の行も色々に含まれます。

お礼

kkkkkm様

早速のご返信ありがとうございます。

No.11、No.12を行ったところ、希望通りのファイルを作成することができました！感謝いたします。

実は、判り易いようにとkkkkkm様が例としてあげて下さったCドライブtestフォルダで作成していましたが、実際のデータはサーバー内のかなり下の階層にあり、移動されることもあります。また、この「台帳」はファイル名やシート名の変更はありませんが、ある一定期間ごとに新しく別フォルダに作成していきます。新しく作成するたびにコードのパス名を書き換えればいいのですが…今現在「台帳」が保存されている同じフォルダ内の「ブック」というフォルダをブックの保存先として指定できるような都合のいい方法はありますでしょうか？

欲を出してしまって申し訳ありませんが、よろしくお願いいたします。

回答No.11

kkkkkm

> 因みに「デバッグ」を選択すると下記部分が黄色くなります。
>
> 「ActiveWorkbook.SaveAs Filename:="C:\test\" & MyFileName」

Cドライブにtestフォルダを作成してやっていただいてるみたいですね。
エラーに関してはすみませんこちらのテストが不十分で訂正漏れがありました。
以下のように訂正してください。
ActiveWorkbook.SaveAs Filename:="C:\test\" & MyFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled

また、上記で解決しない場合

下記のサイトに書かれている状態かどうか確認してみてください。
https://www.wareko.jp/wordpress/?p=2775

回答No.10

kkkkkm

> 教えて頂いたコードを書込み実行したところ下記のようなメッセージが表示されました。

印刷用シートにマクロが記載されているようですね。

Fname = ThisWorkbook.Sheets("印刷用シートα").Range("A1").Value & Format(Date, "_yyyy-mm-dd") & ".xlsx"

を

Fname = ThisWorkbook.Sheets("印刷用シートα").Range("A1").Value & Format(Date, "_yyyy-mm-dd") & ".xlsm"

に変更してみてください。

お礼

kkkkkm様

早々にご対応いただいたにも関わらず日にちが空いてしまい申し訳ありません。

ご指摘の通りにコードの修正をしてみたのですが、修正前と同じ現象が起きてしまいます。
コードやシート名などは、実際のものからコピペしたので間違ってはいないと思うのですが…変更する際に何か勘違いをしてしまっているのでしょうか…

因みに「デバッグ」を選択すると下記部分が黄色くなります。

「ActiveWorkbook.SaveAs Filename:="C:\test\" & MyFileName」

何度も申し訳ありませんがご助力お願いいたします。

回答No.9

kkkkkm

No8の追加です。

実行中に画面表示の切り替えがされて鬱陶しい場合
以下のコードの方に
(ここから同じようなものを15個記載します。と記載した方のコード)
Private Sub CommandButton1_Click()
Dim Fname As String
Dim wb As Workbook
Dim MakeNewFile As Boolean

Application.ScreenUpdating = False
この位置に↑を入れて

Application.ScreenUpdating = True
最後の方のこの位置に↑を入れてください。
ThisWorkbook.Activate
Workbooks(Fname).Close
MsgBox "操作が終了しました", vbInformation
End Sub

お礼

kkkkkm様

日にちが空いてしまい申し訳ありません。

教えて頂いたコードを書込み実行したところ下記のようなメッセージが表示されました。

「次の機能はマクロなしのブックに保存できません。
・定義名で保存されている Excel 4.0 関数。
これらの機能が含まれるファイルを保存する場合は、［いいえ］をクリックし、［ファイルの種類］ボックスでマクロ有効ファイルの種類を選択してください。
マクロなしのブックとして保存する場合は、［はい］をクリックしてください。」

ここで［はい］をクリックすると
「実行時エラー’1004':
この拡張子は、選択したファイル形式には使用できません。［ファイル名］ボックスでファイル拡張子を変更するか、［ファイルの種類］ボックスで別のファイル形式を選択してください。」

［いいえ］をクリックすると
「実行時エラー'1004':
'SaveAs' メソッドは失敗しました: '_Workbook' オブジェクト」

と表示され、どちらの場合も複数シートの内最初にあるシートが新しいブックとして作成されますが、保存はされずリンクも外れていません。

私がコードを書き間違えているのかもしれないので、もう一度試してみようと思いますが、もしアドバイス等ありましたらよろしくお願いいたします。

会社が１８日まで休みになり、その間は停電になるため出勤ができません。
ご返答がさらに遅れてしまいます。
申し訳ありません。

回答No.8

kkkkkm

Excel 2010ということなので2013のコードでも同じだと思いますので、こちらでマクロの記録をしたものに手を加えて掲載します。

まず、標準モジュールに以下のコードをコピペしてください。

Function MacroX(ByVal MySheetName As String, ByVal MyFileName As String, ByVal MakeNewFile As Boolean) As Boolean
ThisWorkbook.Activate
Sheets(MySheetName).Select
If MakeNewFile = True Then
Sheets(MySheetName).Copy
ActiveWorkbook.SaveAs Filename:="C:\test\" & MyFileName
MakeNewFile = False
Else
Sheets(MySheetName).Copy After:=Workbooks(MyFileName).Sheets(Workbooks(MyFileName).Sheets.Count)
Workbooks(MyFileName).Save
End If
Workbooks(MyFileName).BreakLink Name:="C:\test\Book1.xlsm", Type:=xlExcelLinks
Workbooks(MyFileName).Save
MacroX = MakeNewFile
End Function

その中で
ActiveWorkbook.SaveAs Filename:="C:\test\" & MyFileName
上記の
C:\test\
をご自身の実際に保存したいフォルダに変更してください。上記はCドライブのtestフォルダを指定しています。
次に
Workbooks(MyFileName).BreakLink Name:="C:\test\Book1.xlsm", Type:=xlExcelLinks
上記の
C:\test\Book1.xlsm
をマクロを記載しているフルパスのファイル名に変更してください。これでリンクの解除をしてます。

上記2点わからない場合は、マクロの記録で、実際に保存したいところに名前を付けてファイルの保存とリンクの解除を記録してできたマクロで確認してください。

たとえば前者が
"C:\dokoka\ファイル名"
なら
"C:\dokoka\" & MyFileName
後者は、そのまま上記の
Name:="C:\test\Book1.xlsm"
に該当する部分をそっくり変更してください。

次に、フォームに新しいコマンドボタンを配置して、ダブルクリックして開いた画面に
下記のCommandButton1_Clickは作成したボタンの名前になりますので作成されたままの状態で
下記の
Private Sub CommandButton1_Click()
End Sub
の間に書かれているコードをコピペしてください。
なお、シート名に規則性がないようですので、15回チェックボックス名とシート名を変えたものを記載することにしました。

CheckBox1,CheckBox2,CheckBox3のところは実際のチェックボックス名○○○1、○○○2、△△△1、△△△2に変更してください。Meの後ろのドットまで消し、Meのすぐ後ろにドットを打つと右にリストが出て色々なものの一覧の中にチェックボックス名がありますのでそれを選択すると記載ミスが無くなります。一覧に無い場合、チェックボックス名と思っているものが違うという事になります。

Fname = ThisWorkbook.Sheets("印刷用シートα").Range("A1").Value & Format(Date, "_yyyy-mm-dd") & ".xlsx"
この部分の印刷用シートαは実際の印刷用シートのどれでもいいですのでそのシート名を記載してください。
ファイル名に日付が不要な場合は以下のようにしてください。
Fname = ThisWorkbook.Sheets("印刷用シートα").Range("A1").Value & ".xlsx"

なお、ファイル名に使えない文字が管理Noにある場合エラーになりますので、ファイル名をどうするか検討が必要です。
ファイル名に使えない文字
https://www.fmworld.net/cs/azbyclub/qanavi/jsp/qacontents.jsp?PID=3908-2319

MacroX("印刷用シートα", Fname, MakeNewFile)
の部分の印刷用シートα、印刷用シートβ、印刷用シートγはそれぞれチェックボックスに対応したシート名に変更して
if Me.本当のチェックボックス名 = True Then
MakeNewFile = MacroX("チェックボックスに対応した本当のシート名", Fname, MakeNewFile)
End If
としてチェックボックス分記載して下さい。

最後に新規作成したブックは閉じています。エクセル2010の場合、シートを別のブックにコピーして先にコピー元のブックを閉じ、その後新規作成したブックを保存した場合エラーになる事があるので念のために先に新規作成したものを閉じています。

また、出来た新規ファイルを開きそのまま同じ操作をするとシートが再度追加されるので、警告をだして「はい」なら追加するようにしています。

Private Sub CommandButton1_Click()
Dim Fname As String
Dim wb As Workbook
Dim MakeNewFile As Boolean

Fname = ThisWorkbook.Sheets("印刷用シートα").Range("A1").Value & Format(Date, "_yyyy-mm-dd") & ".xlsx"
MakeNewFile = True
For Each wb In Workbooks
If wb.Name = Fname Then
If MsgBox("既に" & Fname & "が開かれています。" & vbCrLf & "シートの追加をしますか?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
MakeNewFile = False
Else
Exit Sub
End If
End If
Next

'ここから同じようなものを15個記載します。

if Me.CheckBox1 = True Then
MakeNewFile = MacroX("印刷用シートα", Fname, MakeNewFile)
End If
If Me.CheckBox2 = True Then
MakeNewFile = MacroX("印刷用シートβ", Fname, MakeNewFile)
End If
If Me.CheckBox3 = True Then
MakeNewFile = MacroX("印刷用シートγ", Fname, MakeNewFile)
End If

'以下残りのチェックボックス分12回同様のパターンで記載
'これ以降はこのままで
ThisWorkbook.Activate
Workbooks(Fname).Close
MsgBox "操作が終了しました", vbInformation
End Sub

回答No.7

kkkkkm

あとエクセルのバージョンも教えてください。

お礼

kkkkkm様

ご配慮ありがとうございます。

OSはWindows ７
Excel 2010を使用しています。

チェックボックス名は、シート名＋シートの種別ごとに半角数字で連番が入っています。（例えば、○○○1、○○○2、△△△1、△△△2のようになっており、15シート全体の通し番号ではありません。）
シート名には連番は入っていません。

また、チェックボックスはシートの出力のみに使用しています。
（使用しているユーザーフォームにはシートごとのチェックボックス15個とキャンセルボタン・印刷ボタンのみがあります。）

質問内容が不十分で二度手間を掛けさせてしまい申し訳ありません。
よろしくお願いいたします。

回答No.6

kkkkkm

> 複数のシートを選択してコピーし、それを１ブック（ファイル）として「A1」セルの内容（つまり業務の管理No.）をファイル名として保存したいのです。

複数のシートをひとつのファイルとして保存したいということですね。ということでしたらNo2の方法ではできませんので、違う方法をとることになります。基本的には同じような事なのですが、マクロの記録を2回していただいて(実際に操作ができれば記録は1回であとはその中身をいじるというやりかたでやるのですが、内容がこちらに見えないので2回していただく方法をとりたいと思います)あとはフォームのボタンのコードをちょっと変更することで可能です。

> この「リンクの解除」を今回の操作に盛り込むことは可能でしょうか？

マクロの記録で新しくコピーしたファイルでその操作をすれば記録してくれますので可能です。記録操作で名前を付けて保存の後でリンクの解除を行ってください。

> また、どこの会社も一緒だとは思いますが、会社業務の持ち帰りは社則で禁止されているため、

そうですね。会社の資料を外部に持ち出すことはある程度の会社でしたらできないようになってますね。返答は実際操作を実行したりもあるでしょうし、仕事もあるでしょうから、ゆっくりでよろしいですよ。

それと、チェックボックス名がCheckBox1,CheckBox2,CheckBox3,…となっていて、シート名が実際に印刷用１、印刷用２、印刷用３…かどうかを教えてください。名前はなんでもいいのですが名前の最後が数値の連番かどうかが知りたいのです。それによってコードが変わりますので。

その場合、その数値が全角か半角かも教えてください。実際のシートからシート名をここにコピペしてもらうとわかりやすいですね。チェックボックスはフォームのデザインでプロパティをみてオブジェクト名がチェックボックス名です。

また、チェックボックスは、チェックを入れたシートの出力用だけにあって他に何かの用途で利用するチェックボックスがあることがあるかないかも教えてください。

回答No.5

kkkkkm

No2ですが
1シート1ファイルとして保存するという前提で考えてますが、あらためて質問を読むと

> 例えば「印刷用１」「印刷用３」をコピーして新しいブック

これはこの2シートをひとつのブックにするという意味ではないですよね。ファイル名がそれぞれのシートのA1セルということでしたので、それぞれのシートをそれぞれのファイルにするという意味だととらえてます。

と言いながら

> ファイル名は「A1」セル

この説明をコードを作成するときに完全に忘れてしまってました。

以下の手順で訂正してください。
Dim Fname As String
これをPrivate Sub CommandButton1_Click()のすぐ下に記載して
以下の一行をCall Macro1の上に追加し(以下のような並びになります)
Fname = ThisWorkbook.Sheets("Sheet" & StrConv(CStr(i), vbWide)).Range("A1").Value
Call Macro1("Sheet" & StrConv(CStr(i), vbWide), Fname & Format(Date, "yy-mm-dd"))
"ファイル名"となっていたところを Fname に変更します。

チェックボックス分を書く方は
Dim Fname As String
これをPrivate Sub CommandButton1_Click()のすぐ下に記載して

If Me.CheckBox1 = True Then
Fname = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
Call Macro1("Sheet1", Fname & Format(Date, "yy-mm-dd"))
End If
以下チェックボックス分

No2ではCheckBox1もCheckBox2も同じSheet1としてたので同じシート名を記載すると勘違いしてしまいそうですが、それぞれ実際のシート名にしてください。

お礼

kkkkkm様

ありがとうございます。
本日の業務が一段落したのでこれからNo2の方法を試みようとしていたところでした。
早々にご回答頂いたのに申し訳ありません。

imogasi様にも指摘されてしまいましたが、私の質問の仕方が曖昧であったために煩わせてしまい申し訳ありません。

「A1」セルですが、「台帳」からマクロを使用して取得した「業務の管理No.」が入っており、印刷用シート15個全てが同一の内容になっています。15個のシートには業務によっては使用しないものも含まれているため、チェックボックスで使用する複数のシートを選択してコピーし、それを１ブック（ファイル）として「A1」セルの内容（つまり業務の管理No.）をファイル名として保存したいのです。
今までは紙出力したシートのみを使用していたのですが、今後はExcelデータとしても使用したいとのことなのです。
また、今日になって印刷用シートに計算式を追加したいと言われてしまいました。そのため、教えて頂いたVLOOKUP関数を値に変換する方法を使用すると計算式まで値になってしまうため使うことができなくなってしまいました。（せっかく教えて頂いたのに申し訳ありません。）
困っていたら職場の人が「リンクの編集」の「リンクの解除」を使用する方法を教えてくれました。この「リンクの解除」を今回の操作に盛り込むことは可能でしょうか？

色々ご迷惑を掛けた上に図々しいとは思いますが、ご教授お願いいたします。
また、どこの会社も一緒だとは思いますが、会社業務の持ち帰りは社則で禁止されているため、ご教授頂いた方法を実施してみることがなかなかできずにご返答が遅れること、お詫びいたします。

回答No.4

imogasi

#3です。いろいろ文章で書いただけなので、参考になるかもしれない部分
「そのブックのシートより必要なシートを選択する　道具立てＶＢＡ」
をサンプルで書いてみます。
これだけでも慣れないと、相当複雑と思いませんか。
やったことがない人には、ＶＢＡはやさしいとは思われない。
ーー
Ｓｈｅｅｔ１に
開発ー挿入ーACTIVEXコントロールーリストボックス
の操作で、リストボックスを１つシートに貼り付け（これもＶＢＡでできますが、無理をしないでおく。）。
開発ーＶＢＥの画面に
Sub test01()
'開発ー挿入ーACTIVEXコントロールーリストボックスの操作の後に
Dim i As Long
Worksheets("Sheet1").ListBox1.Clear
For i = 1 To Worksheets.Count
Worksheets("Sheet1").ListBox1.AddItem Worksheets(i).Name
Next i
End Sub
で現状のシート名のリストが全部出る。
シートが増えても個のルーチンを実行しないとリストに増えない。
ーー
Ｓｈｅｅｔ１のＬｉｓｔＢｏｘの
ListBox1_Click()　イベントに
Private Sub ListBox1_Click()
MsgBox Worksheets("Sheet1").ListBox1.List(ListBox1.ListIndex)
r = Worksheets("Sheet1").Range("A1000").End(xlUp).Row + 1
Cells(r, "A") = Worksheets("Sheet1").ListBox1.List(ListBox1.ListIndex)
End Sub
を入れる。
＝＝
Ｓｈｅｅｔ１のリストボックスのアイテムの１つをクリックすると、クリックした「シート名」が、Ｓｈｅｅｔ１のＡ列に累積される。
それをもとにその後の処理に利用する。

回答No.3

imogasi

＃２あたりで問題解決すれば結構なことですが。
こういう仕事がらみの質問内容を表現するには、その前提として、それなりのエクセルやシステムの訓練や経験が要ります。
どういうことを言っているのか、私から言わせれば、質問点も多々あります。
ただし、シートを（自動的にブック化して、）保存する（操作は存在しないので）ことはできないので、新しい空白ブックを開いてそこに、元のブックの「１シートないしは複数シート」（＝Ｘ）を貼り付けて、保存せざるを得ません。あるいは１シートを１ブックずつ希望なのかどうか。それと他ブックへコピーすると他ブックを参照することになるが、そのままにしておくのか、値化しても良いのかも不明です。
Ｘをどのように指定すべきかは、質問者が考えないとなりません。
そのための道具（プログラムや操作の一まとまり。ルーチン）はあらかじめ知ってないと、その先を今すぐ考えを進める役に立ちません。
＞当方はVBAは用語もろくにわからない全くの初心者ですので、詳しい解説も添えていただけると勉強にもなり非常に助かります。
は、あまりにも質問者本位で、回答者は（解説できる文字数や許容時間もあるので）対応できないだろう。
ーー
また
シートタブで右クリック
移動またはコピー
移動先ブック名 Ｂｏｏｋ２
コピーを作成する、にチェック
ＯＫ
シートの式を値化する(＝の式がある部分の式を消す）
のような操作をして、マクロの記録を取ってみるのも良いかも。
ーー
１つの方法は、手作業のステップを１つづつ書き上げて、それぞれで毎回変わる箇所をはっきり認識することです。（この質問もその点大雑把すぎると思います。）
そっくり作ってくれというには、細部まで知る必要がありますが、質問に文章で内容を書けない人がほとんどです。またこのコーナーにはどだい無理ですが。
それに対処する方法を、質問でもして、まず文章上で、解決することが先決です。
その後に、どうＶＢＡにコーディングすべきかに進めるとよいでしょう。

お礼

imogasi様

ご返答ありがとうございます。
行いたいことがうまく表現できず、煩わしい思いをさせてしまい申し訳ありません。
自分の考えているイメージを他人に伝えるのは難しいです。
ただ、今回は業務のこともあり気持ちが焦っていたため、回答者の皆さまの都合にまで考えが至らずこのような質問の仕方になってしまいました。

今後は勉強のために色々な作業のマクロを記録して、どのようなコードになるのかを色々と試してみようと思います。