VBA ひな型を壊さないようにするには？（ひな型の形を変える処理がある場合）
こんにちは。
派犬事務員のコロ子です。
前回からの続き
koroko.hatenablog.com
で、
「転記の処理の途中で、行を削除したり、列を追加したり、ひな型の形を変更する処理がある場合はどーするの？」
ですよね？
この場合は、さらに作業用のシートを用意するので、ちょっとややこしい。
① ひな型をコピーする（作業ブック）
② 作業ブックを開く
③ リストデータの数だけループ
【ループの中で】
③-1 作業ブックのひな型シートをコピーする（作業シート）
③-2 作業シートを処理
③-3 作業シートを名前を付けて保存する
③-4 作業シートを削除する
④ 作業ブックを閉じる
⑤ 作業ブックを削除
リストデータの数だけ、シートをコピーしたり、削除したりするので、ちょっと重い処理になる。もっと良い方法があるのかもしれないけど、ひとまずコードを書いてみた。
Sub 注文書作成_3() Application.ScreenUpdating = False '作業用ブックの名前は「作業用年月日時分秒.xlsx」にする Dim tmp As String tmp = "\作業用" & Format(Now, "yyyyddmmhhnnss") & ".xlsx" '注文書ひな型をコピーして作業ブックを作成する FileCopy ThisWorkbook.Path & "\注文書ひな型.xlsx", ThisWorkbook.Path & tmp Dim wb As Workbook Dim ws As Worksheet '作業用ブックを開く Set wb = Workbooks.Open(ThisWorkbook.Path & tmp) Dim i As Long For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'ひな型シートを別シートにコピーする。 wb.Worksheets("ひな型").Copy After:=Worksheets("ひな型") Set ws = ActiveSheet Dim strName As String strName = Cells(i, 2).Value '途中ポイントごとに作業ブックを保存する wb.Save 'リストのデータを作業用ブックに転記 ws.Range("C5").Value = strName '名前 ws.Range("C10").Value = Cells(i, 1).Value '日付 ws.Range("D10").Value = Cells(i, 3).Value '品名 ws.Range("E10").Value = Cells(i, 4).Value '金額 '行を削除する処理とか ws.Rows("12:20").Delete 'wsシートを別ブックにコピー ws.Copy '名前を付けて保存 ActiveSheet.Parent.SaveAs ThisWorkbook.Path & "\領収書(" & strName & ").xlsx" '閉じる ActiveSheet.Parent.Close 'wsを削除 ws.Delete Next i '作業用ブックを閉じる wb.Close SaveChanges:=False '作業ブックを削除 Kill ThisWorkbook.Path & tmp Application.ScreenUpdating = True End Sub
VBA ひな型を壊さないようにするには？
こんにちは。
派犬事務員のコロ子です。
今月から「ノンプログラマーのためのスキルアップ研究会」初心者講座VBA コース6期が始まりました。講師はichihuku@VBAerさんです。コロ子は僭越ながらTA（ティーチングアシスタント）をさせて頂いてます。
TAは何度やっても勉強になる
コロ子ばっかり何度もTAやらせてもらってありがとうございます。TAは本当に何度やっても勉強になる。
ノンプロ研の講座は事前課題がかなり大量に出るけど、みんなちゃんとやってくるのがすごい。事前課題でもらった質問の解決法を書いてみます。
ひな型が上書きされちゃう問題
【課題】
元の課題はこれだけど、
atmarkit.itmedia.co.jp
説明を簡単にするためにちょっとアレンジします。
下記の書式の注文書を
リストのデータ分だけ作りたい。
【作成方法】
① 注文書ひな型を開く
② リストデータを注文書ひな型に転記する
③ 名前をつけて保存（ファイル名：注文書(名前).xlsx）
④ ②③をリストのデータの数だけ繰り返す
⑤ 注文書ひな型を閉じる（保存しない）
リスト.xlsmのシートモジュールに下記コードを記載する
Sub 注文書作成() Dim wb As Workbook Dim ws As Worksheet '注文書ひな型を開く Set wb = Workbooks.Open(ThisWorkbook.Path & "\注文書ひな型.xlsx") Set ws = wb.Worksheets("ひな型") 'リストをデータの数だけループする Dim i As Long For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row 'リストのデータをひな形に転記 Dim strName As String strName = Cells(i, 2).Value ws.Range("C5").Value = strName '名前 ws.Range("C10").Value = Cells(i, 1).Value '日付 ws.Range("D10").Value = Cells(i, 3).Value '品名 ws.Range("E10").Value = Cells(i, 4).Value '金額 'ブックを別名で保存 wb.SaveAs ThisWorkbook.Path & "\注文書(" & strName & ").xlsx" Next i '注文書ひな型を閉じる（保存しない） wb.Close End Sub
コードを実行すると、各々の注文書ができている。
このような処理は本当に良く使う。
で、頂いた質問は「注文書ひな型にデータが入った状態で上書きされちゃった」
うわー、これ、本当によくある！
そして、ひな型が上書きされると非常に困ることも良くある。
処理の途中で行を追加したり削除したりしてる場合などは最悪！
（このサンプルでは問題ないけど。）
上書きされる原因は、処理の途中で何らかのエラーが出て止まってしまった場合、ひな型をうっかり上書き保存しちゃった、がほとんどだと思う。あのフロッピーマークは無意識に押してしまう。
コード作成中にもあり得るし、運用中にもあり得る。（自分以外の人が使う場合は絶対落ちないコードを書かなくちゃいけないけど、それは今は置いておこう）
そうなると、舌打ちしながらひな型を元に戻す作業が生じる。
そんな場合の解決法は
①ひな型をコピーする（作業ブック）
FileCopy コピー元ブック名, コピー先ブック名
②作業ブックを開いて処理する
③途中、要所要所で作業ブックを上書き保存
④作業ブックを閉じる
⑤作業ブックを削除
Kill ファイル名
エクセルを開いて作業してるときに勝手にできるテンポラリーファイルみたいなイメージかな？（ちょっと違う？）
作業ブックを使って処理しているので、途中エラーで止まってしまっても元のひな型はそのままなので安心。
正常に終了していれば、作業ブックは削除されているので、作業ブックが存在していたら、何かしらエラーで止まったことが分かる。さらに要所要所で保存しているので、自分以外の人が使った場合、エラーの場所が推測がしやすくなる。
Sub 注文書作成_2() '作業用ブックの名前は「作業用年月日時分秒.xlsx」にする Dim tmp As String tmp = "\作業用" & Format(Now, "yyyyddmmhhnnss") & ".xlsx" '注文書ひな型をコピーして作業ブックを作成する FileCopy ThisWorkbook.Path & "\注文書ひな型.xlsx", ThisWorkbook.Path & tmp Dim wb As Workbook Dim ws As Worksheet '作業用ブックを開く Set wb = Workbooks.Open(ThisWorkbook.Path & tmp) Set ws = wb.Worksheets("ひな型") Dim i As Long For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Dim strName As String strName = Cells(i, 2).Value '途中ポイントごとに作業ブックを保存する wb.Save 'リストのデータを作業用ブックに転記 ws.Range("C5").Value = strName '名前 ws.Range("C10").Value = Cells(i, 1).Value '日付 ws.Range("D10").Value = Cells(i, 3).Value '品名 ws.Range("E10").Value = Cells(i, 4).Value '金額 'ブックを別名で保存 wb.SaveAs ThisWorkbook.Path & "\注文書(" & strName & ").xlsx" wb.Save Next i wb.Close '作業ブックを削除 Kill ThisWorkbook.Path & tmp End Sub
どうでしょうか？
ActiveXコントロール チェックボックスでフィルターOn/Off
こんにちは。
派犬事務員のコロ子です。
最近ブログサボってました・・・。
オートフィルターって便利だけど、▽クリックして、検索文字を入力したり、チェックボックスをポチポチしたり、なんかめんどくさい。
色で検索できたり、多機能だけど、日常的には文字列での検索しか使ってない。
こんな表に新規のデータを入力する。
コロ子：えっと、会社名は○○
Aさん：ちゃんと○○株式会社と入力してください。後でフィルターするときの検索が面倒になるので。
コロ子：はい。すみません。
コロ子：フルーツ、すいか
Aさん：フルーツじゃなくて果物と入力してください。それから、すいかは果物ではなく野菜です。
コロ子：すみません・・・。
Aさん：入力するときに過去に同じようなのがあるのでそれを参考にしてください。
オートフィルターで絞って探せますよ。前回の入力時に注意事項も入力しているので、そちらも必ず参考にしてください。
コロ子：はい・・・。
フィルタでポチポチしながらデータを絞る。
○○株式会社はみかんだけど、オレンジでもいいのかー。注文書に今回はグレープフルーツも可とかいてある。よし、備考に書いておこう。
△△株式会社の胸肉は皮なしなのね。
最初はいいけど、これを1日何十回。
フィルタの解除も▽をクリックして「全て選択」をポッチ。しかも解除すると、なんかへんな位置にカーソルが行ってる。今入力してるの一番下の行なんだけど！
ちっちゃいイラっとも溜まればストレス。
なのでチェックボックスのOn/Offでフィルターできる機能を付けてみた。
チェックオン：カーソル位置の値で絞る
チェックオフ：絞り解除。元のカーソル位置に戻る
ActiveXコントロール チェックボックス
先ずは、チェックボックスを挿入する
開発タブ
↓
挿入
↓
チェックボックス
を選択する
先頭行に配置する
先頭行は固定にしておく。（フィルター機能付けてるので当然だけど）
準備できたらコードを書いてみよう。
ActiveXコントロールはシートのイベントが使える。素晴らしい！
シートモジュールのオブジェクトボックスに先ほど作成したCheckBox1~5がいる。
となりのプロシージャボックスからClickを選択する。
'最初のカーソル位置を記憶しておく
Private myRan As Range
Private Sub CheckBox1_Click()
Call CheckBox_Filter(CheckBox1.Value, 3)
End Sub
Private Sub CheckBox2_Click()
Call CheckBox_Filter(CheckBox2.Value, 4)
End Sub
Private Sub CheckBox3_Click()
Call CheckBox_Filter(CheckBox3.Value, 5)
End Sub
Private Sub CheckBox4_Click()
Call CheckBox_Filter(CheckBox4.Value, 6)
End Sub
Private Sub CheckBox5_Click()
Call CheckBox_Filter(CheckBox5.Value, 7)
End Sub'ckBox As Boolean チェックボックス値（オン/オフ）
'c As Long フィルターする列
Private Sub CheckBox_Filter(ckBox As Boolean, c As Long)
Application.ScreenUpdating = False
If ckBox Then
'元のカーソル位置を記憶（チェックボックスが全てオフのとき）
If myRan Is Nothing Then
Set myRan = ActiveCell
End If
'元のカーソル行でチェックが入ったチェックボックスの列の値を含む文字列でフィルタする
Dim searchStr As String
searchStr = Cells(myRan.Row, c)
Range("A1").AutoFilter c, "*" & searchStr & "*"
Else
Range("A1").AutoFilter 'オートフィルタをはずす
Range("A1").AutoFilter 'オートフィルタを付ける
'全てのチェックボックスのチェックをはずす
Dim ckb As OLEObject
For Each ckb In OLEObjects
If InStr(ckb.Name, "CheckBox") <> 0 Then
ckb.Object.Value = False
End If
Next
Application.ScreenUpdating = True
'最初の位置を選択してmyRan変数をリセット
If Not myRan Is Nothing Then
myRan.Select
Set myRan = Nothing
End If
End If
Application.ScreenUpdating = True
End Sub
Range("A1").AutoFilterはオートフィルターがない場合はつける、ついている場合は外す。
Range("A1").AutoFilterでオートフィルターを外すと絞り込みを解除するだけではなく、オートフィルター自体も解除されてしまうので、もう一度Range("A1").AutoFilterでオートフィルターを付ける。何かダサいので多分もっといい方法があると思う。
複数チェックボックスにチェックを外す場合
ckb.Object.Value = False
でいちいちイベントが発生してしまう。
Application.EnableEvents = False
ckb.Object.Value = False
Application.EnableEvents = True
でイベントの発生を無効にしようと思ったけど、上手くいかない。
ActiveXコントロールはApplicationのイベントではないのかな？
なので何度もこの処理を通るため、元の位置に戻るときにmyRanがnothingかどうか判定した。
【結果】
超快適！
ちなみにActiveXコントロールのプロパティは
①開発タブ
↓
②デザインモード
↓
③対象のオブジェクトを選択
↓
④プロパティ
から設定できる。
設定し終わったらデザインモードをオフにするのを忘れずに。
プルダウンでなくてユーザーフォームで選ぶ（プルダウンの文字数が多い場合）
こんにちは。
派犬事務員のコロ子です。
以前書いた「連動したプルダウンを作る」の記事に「リストに入れる文字数が多くなるとVBAが壊れる現象が起きる」というコメントを頂いて、調べてみたら、プルダウンリストには255文字までしか入らないらしい。
おお！知らなかった。
でも、コロ子のコードでは「名前付き範囲を指定する」方法なので文字制限は気にしなくて良さそう。実際試してみたら255文字以上も大丈夫だった。
どういう状態なのかな。大丈夫かな？
状況が良く分からないけど、プルダウンで長い文字を選択するのはちょっと大変そう。
そこで、長～い文字を簡単に入力するにはどうすれば良いか考えてみた。
VLOOKUPのパワーアップ版のイメージでユーザーフォームを使うのはどうだろうか？
【例】
この表のコメント列を入力したい。
プルダウンで選択するには文字列が長すぎる。
一覧表シート
①長い文字列の選択用のシートを作成する（選択用コメントシート）
A列：見出し
B列：長い文字列（内容）
②ユーザーフォームを作成する
・表のD列でダブルクリックをするとユーザーフォームが立ち上がる。
・ユーザーフォームのリストに見出しが出る。
・見出しを選択すると、テキストボックスに内容が表示される。
テキストボックス内で内容の変更も可能。
・OKボタンを押すと表のコメント欄に内容が入る。
ではユーザーフォームを作ってみよう。
ユーザーフォーム名：UserForm2（いろいろいじっていたら2になっちゃった）
上のボックス：ListBox1
下のボックス：TextBox1
※TextBox1は改行可にするためにプロパティのEnterKeyBehavior をTrueにする。
OKボタン：CommandButtonで作成。オブジェクト名もCaptionも「OK」
コード
【Sheet1（一覧表シート）】
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'D列をダブルクリックした時ユーザーフォームを立ち上げる
If Target.Column = 4 Then
UserForm2.Show
End If
End Sub
【ユーザーフォーム】
'ユーザーフォームが開くタイミングで実行される
Private Sub UserForm_Initialize()
Dim i As Long
Dim ws As Worksheet
Set ws = Sheets("選択用コメント")
For i = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row
'リストボックスに見出しを追加
ListBox1.AddItem ws.Cells(i, 1).Value
Next i
End Sub
'ListBox1（見出し）を選択した時
Private Sub ListBox1_Click()
Dim i As Long
i = ListBox1.ListIndex
'ListBox1のインデックス番号は0から始まる&2行目から始まる→+2
TextBox1.Value = Sheets("選択用コメント").Cells(i + 2, 2).Value
End Sub
'OKボタンを押した時
Private Sub OK_Click()
ActiveCell.Offset(0, -1).Value = TextBox1.Value
'ユーザーフォームを閉じる
Unload UserForm2
End Subこれじゃダメかな？
VBA 罫線で囲まれた範囲を取得する（田んぼRange）
こんにちは。
派犬事務員のコロ子です。
よくありがちなこんな表。
罫線で囲まれた表の外に自由に書き込みがされている。
表の中に空白行があるけど、区切りの意味があるらしく、勝手に削除できない。
この状態に手は加えず、表だけを取得したい。
UsedRange だと、枠の外も使用範囲が全部になってしまう。
Range("C3").CurrentRegion だと、連続している範囲になってしまう。
罫線で囲まれた範囲だけ取得する関数とかあっても良さそうだけどなー。
ないっぽいので自作してみよう。
Sub Test()
田んぼRange(Sheet1).Select
End Sub
Function 田んぼRange(ws As Worksheet) As Range
Dim linRange As Range
Dim ran As Range
For Each ran In ws.UsedRange
If ran.Borders.LineStyle = xlContinuous Then
If linRange Is Nothing Then
Set linRange = ran
Else
Set linRange = Union(linRange, ran)
End If
End If
Next ran
Set 田んぼRange = linRange
End Function
枠全てに罫線が引かれているセルをUnion関数で繋げて範囲を取得する。
できた！
罫線で囲まれた範囲を田んぼRangeと命名しよう。
（ネーミングがダサい？でも分かりやすいでしょ！ちゃんとした名前あるのかな？）
田んぼRange、もしかしたらUsedRangeやCurrentRegionよりもニーズがあるかも！？
おしゃべりがうるさーい！（悩み）
こんにちは。
派犬事務員のコロ子です。
現在「こーゆーの作って」を作る謎の一人部署で毎日VBAを書いている。
一人なので専用の部屋はなく、総務に間借りをしている。
そんな状況で困った事がある。
それは「うるさい」ことだ。
総務なのでいろいろな人が出入りする。その度におしゃべりが盛り上がって非常にうるさい。めちゃめちゃ考えている時に集中できなくて困る。
しかも話の内容丸聞こえなんですけど！
時々「うるさーい！」って叫びそうになるけど、さすがに間借りしている分際でそれは言えない。
昔から音楽を聴きながら、ラジオを聴きながら勉強とかできないタイプだった。
だって一緒に歌っちゃうから。
そんなわけで、聞き耳を立ててるわけでもないのに（できれば聞きたくない話が多い）仕事にならなくて困っている。
何度も上司に相談しようと思い、でもそんな相談されても困るよなぁ、と思いとどまる、を繰り返していた。
が、先日ついに我慢ができなくなり上司に相談に行った。さすがに小学生じゃないからおしゃべりを注意してもらう、とかはないけど、あわよくば在宅勤務とかもちょっと期待しながら。
上司：「ヘッドフォンしていいよ」
ええっーーー！！マジですかー！音楽聞いていいんですか！！
それ、海外ドラマとかで見た事あるー！
ヘッドフォンしながらオフィスで仕事。超憧れるけど、さすがに日本企業じゃおかしくない？しかもかなり古いタイプの会社だし。
コロ子：「ヘッドフォンですか？防音の意味でですよね？」
上司：「そう。それで対処してくれる？」
コロ子：「ちょっとさすがに、角が立たないですか？」
上司：「何か言われたら、私が許可した、って言っていいよ。」
そうは言われても・・・。
ってなわけで、職場でのヘッドフォンを許可された。
でも突然仕事中にヘッドフォンするのもおかしいよな・・・。
まずは毎日ヘッドフォンをして出社し、仕事中は首から下げてファッションアイテムとして定着させるべきか・・・？
ヘッドフォンは大げさだから、ワイヤレスのイヤフォンをするべきか？髪（耳）で隠せるし。
でも、そんなコソコソした感じにしたら、周りから「派犬のくせに仕事中隠れて音楽聞いてる」って言われるよな・・・。派犬は周りからの評価が仕事に響くんだよ・・・。
ちょっとウサ子に相談してみよう。
ウサ子：「いいな～。仕事中ヘッドフォンしていいんだ～」
コロ子：「全然良くないよ～。いくらうるさいからって、そんな嫌味なことしたら角が立つよ」
ウサ子：「そんなことないよー。とびっきりいいヘッドフォン買いなよー。派犬なんて仕事上のヒエラルキーは最下位なんだから、ヘッドフォンヒエラルキーで最上位になりなよー。」
意味不明。いまだ悩み中。
VBA カッコはどういうときに付けるの？
こんにちは。
派犬事務員のコロ子です。
実は今ノンプロ研のVBA初級講座でティーチングアシスタント（TA）をしている。前回、中級講座のTAでもテンパったけど、初級講座でも受講生からの鋭い質問にテンパっている。
先日はカッコの付け方についての質問があった。
メッセージボックスで
MsgBox "派犬", vbOKOnly ←実行できる
MsgBox ("派犬",vbOKOnly) ←エラーになる
どうしてカッコを付けるとエラーになるのですか？うわ～（汗）めちゃめちゃいい質問。
なんとなく雰囲気で戻り値を受ければいいのは分かる。
でも、どうしてカッコが要らないのかは答えに詰まる。
似たようなので
Workbooks.Open
これもいつもカッコが要るのか要らないのかあやふやで、エラーが出たらカッコを取る、みないなことをしている。
長年なんとなく放置した問題についに向かい合う時がきた。
Office TANAKAのサイトでは下記のようなルールだといっている。
返り値を何かに使うときは、引数を括弧で囲まなければなりません。
返り値を何かに使わないときは、引数を括弧で囲ってはいけません。これが、VBAにおける括弧のルールです。
なるほどー。ルールなのかー。
でも、何でもカッコをつければ戻り値が戻るとは思えない。
いったいどんなときにカッコをつければいいのだろう。
オブジェクトブラウザを見てみる
VBEエディタでF2キーを押すとライブラリ一覧が表示される。
MsgBoxを検索して下のを見てみると説明が書いてある。
Functionとなっている。MsgBoxはFunctionプロシージャなのだ。
Functionプロシージャなので当然、戻り値がある。
他のプロシージャを呼び出すには
Callは他のSubプロシージャーやFunctionプロシージャーを呼び出すことができる。
ただし、Callを使ってFunctionプロシージャーを呼び出す場合は戻り値は破棄される。
ということはCallは呼び出すだけで戻り値はない。
Callを使って他のプロシージャを呼び出すには、引数をカッコで囲む。
Call プロシージャ名(引数1, 引数2,…)
Call は省略できる。その場合はカッコを外す。
プロシージャ名 引数1, 引数2,…
ということで、戻り値がない他のプロシージャを呼び出す書き方は上記の2通り。
MsgBoxはFunctionプロシージャだけど、vbOKOnlyなどボタンが1つで、あえて戻り値が必要ない場合は上記のどちらかの方法で呼び出す。
Callを付けるか、カッコを外すか。たまーにCallがついているのを見かけるけど、カッコを外すのが一般的なんだろう。
Call MsgBox("派犬", vbOKOnly)
MsgBox "派犬", vbOKOnlyちなみに
Workbooks.OpenのOpenもFunction
Application.RunのRunもFunction
UnloadはSub
Collectionオブジェクト.AddのAddはSub
