Excel フォーム上のコントロールを変数に格納

（対象）Excel　VBA

（確認）Excel2010、2013

今回はExcelのフォーム上に配置したコントロールを
変数に格納して使用する方法です。


（手順）
１．変数を準備。この時、使用するのはただの
　　「TextBox」などではなく、「MSForms.」と
　　頭についているものにする

　　→　例）Dim FText As MSForms.TextBox
　　　　　　↑フォーム上のテキストボックス


２．「Set」を使用して変数に格納

　　→　例）For CNT = 1 To 5

　　　　        　Set FText = Me.Controls("Text_テキスト" & CNT)

　　　　        　FText.Text = ""

　　　　　   Next

（実際の使用例）
　オープン時　 ： 中身を削除
　ボタン押下時 ： コントロールの名前を格納

　↓　ソース
　

　Dim FText As MSForms.TextBox

　

　

　Private Sub UserForm_Initialize()

    　'■初期化

    　For CNT = 1 To 5

       　 Set FText = Me.Controls("Text_テキスト" & CNT)

       　 FText.Text = ""

   　 Next

　End Sub

　

　Private Sub Bt_表示_Click()

    　'■順次コントロール名を格納

    　For CNT = 1 To 5

        　Set FText = Me.Controls("Text_テキスト" & CNT)

        　FText.Text = FText.Name

    　Next

　End Sub

---

同じようなコントロールがいくつも出てくるとき
などに非常に便利です。


シート上のコントロールに入れる方法は割とすぐに
見つかりましたが、こっちの「MSForms」は中々
出てこなくて最初ちょっと困りました。

Excel ブックにパスワードをつける

（対象）Excel　VBA

（確認）Excel2010、2013

今回はExcelブック自体にパスワードをつける
方法です。


（手順）
１．Excel ブックを開く
２．名前をつけて保存
　　
３．「ツール」－「全般オプション」

４．パスワードの設定
　　読み取りパスワード　→　入力しないと中身も見えない
　　書き込みパスワード　→　入力しなくても中身は見える

　　１）パスワード設定画面
　　　　

　　２）読み取りパスワードを追加した場合、次に開く時
　　　　最初に出るダイアログ
　　　　

　　３）書き込みパスワードを追加した場合、次に開く時
　　　　最初に出るダイアログ
　　　　

　　４）読み取り専用を推奨するにチェックを入れた場合、
　　　　次に開く時出るメッセージ
　　　　

　　２）～４）までは設定したものは全て表示される

---

このパスワードは忘れてしまうとどうしようも
ありませんのでご注意ください。

Excel VBA シートの保護と解除

（対象）Excel　VBA

（確認）Excel2010、2013


今回はExcelでシートの保護と解除をする時の
動作です。

普段はユーザーに触って欲しくないけれど
マクロで作業中はセルの変更や行列の追加削除を
行いたい。

そんな時は作業中に保護・解除を行ってみましょう。
どちらも一文で行えます。

---

'===========================================================

' シートの保護

'===========================================================

Sub SheetProtect()

  '■アクティブシートの保護

  'Password　　　　　＝　パスワード

  'userInterfaceOnly ＝　動作を制御する対象をユーザーの操作のみにする

  ' 　　　　　　　　　　（宣言しないとマクロ動作も制御してしまう）

  

  '１．パスワードつき

  ActiveSheet.Protect Password:="password", userInterfaceOnly:=True

  

  '２．パスワードなし

  'ActiveSheet.Protect, userInterfaceOnly:=True

End Sub

'===========================================================

' シートの保護を解除

'===========================================================

Sub SheetUnProtect()

  '■アクティブシートの保護を解除

  '１．パスワードつき

  ActiveSheet.Unprotect Password:="password"

  

  '２．パスワードなし

  'ActiveSheet.Unprotect

End Sub

---

保護と解除は割と使うことが多い作業でしょうか。


では今回はこの辺りで。

Excel VBA ブックを閉じる時他に開いているか確認

（対象）Excel　VBA
（確認）Excel2010、2013


今回はExcelでブックを閉じる時の確認動作です。

多分2010からだった気がしますが、2003の時の
閉じ方をすると、中身だけ消えてExcel自体が
残った状態になってしまいます。

でも全部消えるようにすると、複数ブックを
開いている時に困る。


そんな時は以下の通りの判断なんてどうでしょう。

※いらない部分もいくつかあるかもです

―――――――――――――――――――――――――――

＜変数＞

Dim MSG   As String　

Dim EndFG As Boolean

Dim WB1   As Workbook

＜呼び出し＞

'============================================

' ブックを閉じる時

'============================================

Sub auto_close()

    CloseThisFile

End Sub

※「auto_close」についてはこちらの記事

＜本文＞

※今回はExcelのVBAを保存しているファイルである
「PERSONAL.XLS」を含めて指定しています。


'===========================================================

' Excelの終了

'===========================================================

Sub CloseThisFile()

  '■終了の仕方を確認

  MSG = MsgBox("Excelを保存して終了する場合は「はい」を、" & vbCrLf & vbCrLf & _

               "保存しないで終了する場合は「いいえ」を押してください", vbQuestion + vbYesNoCancel, "【終了確認】")

  

  

  '■終了の選択によって閉じ方を変更

  EndFG = False

  If MSG = vbYes Then

    '＜保存して閉じる＞

    '△開いているのが1つのとき、もしくは2つで片方が「PERSONAL.XLS」の場合は保存してアプリケーションごと閉じる
    '※もうひとつ確実に開いているファイルがない場合はこの条件は前者だけでOK
    '※「BooksCheck」は上のファイルがない場合は不要の処理

    BooksCheck

    If Workbooks.Count = 1 Or (Workbooks.Count = 2 And EndFG) Then ThisWorkbook.Save: Application.Quit

    

    '△それ以外は普通にClose使って閉じる（保存する）

    ThisWorkbook.Close savechanges:=True

    

  ElseIf MSG = vbNo Then

    '＜保存しないで閉じる＞

    '△開いているのが1つのとき、もしくは2つで片方が「PERSONAL.XLS」の場合はアプリケーションごと閉じる

    BooksCheck

    If Workbooks.Count = 1 Or (Workbooks.Count = 2 And EndFG) Then Application.Quit

    

    '△それ以外は普通にClose使って閉じる（保存しない）

    ThisWorkbook.Close savechanges:=False

  End If

End Sub

※今回は「PERSONAL.XLS」があるかどうか。
確実に同時に開いている他ファイルがない場合は
このプロシージャは不要。

'===========================================================

' ブックの確認

'===========================================================

Sub BooksCheck()

  '■開いているブックをひとつずつ確認

  ' （この例の場合は「PERSONAL.XLS」の有無）

  For Each WB1 In Workbooks

    If WB1.Name = "PERSONAL.XLS" Then EndFG = True: Exit For

  Next

End Sub

―――――――――――――――――――――――――――

こんな感じです。

ちなみに終了確認の時のダイアログはこんな感じ↓



余計な部分もありますが、何か一緒に開いている物がある、
という場合には重宝したりします。（個人的には）


では今回はこの辺りで。

Excel シートを新規ブックに移動

（対象）Excel　VBA

（確認）Excel2003（多分2010でも使える）

今回はワークブック内のシートを新しいブックに保存する方法を

書いていこうと思います。

私がこれを使ったのは、たとえば毎日の処理でシートが徐々に

増えていくプログラムなどでした。

なので、今回の流れとしては

「月が替わったら前月のシートを全て新しいブックに移す」

となります。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

（前提）

　１．各対象シートのB1セルに日付が入っている

　２．DontLookやOKLookなどを使用→詳しくはこちら

（プログラム）

　　'============================================================

　　' 月ごとにシートの抜き出し

　　'============================================================

　　Sub Nukidasi()

　　　　Dim I       As Integer

　　　　Dim MyFile  As String

　　　　Dim MyDate  As String

　　　　Dim Moji    As String

　　　　Dim WB1     As WorkBook

　　　　Dim WB2     As WorkBook

　　　　Dim WHX     As WorkSheet

　　　　'■インプットボックスで年月を指定（※1）

　　　　MyDate = InputBox("抜き出すデータの年月を西暦で入力してください(Ex: 201307)", "年月指定")

　　　　'■データが空だったり数字以外だったら処理を抜ける

　　　　If MyDate = "" Then

　　　　　　MsgBox "入力がされませんでした。処理を中断します", vbExclamation, "【報告】"

　　　　　　 Exit Sub

　　　　ElseIf Not IsNumeric(MyDate) Then　'(※2)

　　　　　　MsgBox "数字以外が入力されました。処理を中断します", vbExclamation, "【報告】"

　　　　　　Exit Sub

　　　　End If

　　　　'■指定年月に当てはまるものを新しいブックに保存していく

　　　　DontLook

　　　　'1.ブックを設定

　　　　Workbooks.Add

　　　　Set WB1 = ThisWorkbook

　　　　Set WB2 = ActiveWorkbook

　　　　WB1.Activate

　　　　'2.該当のシートを移していく

　　　　I = 1

　　　　Do Until I > ThisWorkbook.Worksheets.Count

　　　　　　Set WHX = Sheets(I)

　　　　　　Moji = Replace(Left(WHX.Range("B1").Value, 7), "/", "")　'(※3)

　　　　　　'△指定した年月と一致したら移動する

　　　　　　If MyDate = Moji Then

　　　　　　　　Sheets(I).Move After:=WB2.Sheets(WB2.Worksheets.Count) '(※4)

　　　　　　　　WB1.Activate

　　　　　　　　I = I - 1　'(※5)

　　　　　　End If

　　　　　　I = I + 1

　　　　Loop

　　　　'3.新しいブックから「Sheet*」のシートを消す

　　　　I = 1: WB2.Activate

　　　　Do Until I > WB2.Worksheets.Count

　　　　　　If Sheets(I).Name Like "Sheet*" Then

　　　　　　　　Sheets(I).Delete

　　　　　　　　I = I - 1

　　　　　　End If

　　　　　　I = I + 1

　　　　Loop

　　　　'■ファイル名をつけて保存

　　　　MyFile = ThisWorkbook.Path & "\" & MyDate

　　　　WB2.Close SaveChanges:=True, Filename := MyFile　'(※6)

　　　　OKLook

　　End Sub

（解説）

　※1

　　＝上の例だと入力させるのは1回きりだが、入力完了するまで

　　　回したい、もしくは終了を選択したい場合は以下の通り。

　　　フラグがTrueになるか処理を抜ける判断をしたら処理を抜けます。

　　－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

　　　Sub test_012()

　　　　　Dim FLG   As Boolean

　　　　　Dim MyStr As String

　　　　　Dim MSG   As String

　　　　　FLG = False

　　　　　Do

　　　　　　MyStr = InputBox("数字を入力してください", "入力")

　　　　　　If IsNumeric(MyStr) Then FLG = True

　　　　　　If Not FLG Then

　　　　　　　　MSG = MsgBox("空白、もしくは数字以外が入力されました。" & _

　　　　　　　　　　　　　　　vbCrLf & vbCrLf &  "入力を繰り返しますか？", & _

　　　　　　　　　　　　　　　vbQuestion + vbYesNo, "確認")

　　　　　　　If MSG = vbNo Then Exit Do

　　　　　　End If

　　　　　Loop Until FLG

　　　　　If Not FLG Then Exit Sub

　　　　　MsgBox MyStr & " : " & FLG

　　　End Sub

　　－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

　※2

　　＝「If Not IsNumeric(MyDate)」

　　　・・・IsNumeric（対象）　：　対象が数字か判断

　　　・・・Not ～　：　結果がTrueかFalseになる式の時、「If ○ Then」だと

　　　　　　　　　　　「Trueの時」になるが、Notがつくと「Falseの時」になる

　※3

　　＝「Replace(Left(WHX.Range("B1").Value, 7), "/", "")」

　　　・・・Left(文字列, 文字の長さ）　：　文字列の左から文字数分取得

　　　・・・Replace（文字列, 検索文字列, 置換後文字列）

　　　　　　　：　文字列に含まれる検索文字列を置換後文字列に変換する

　　　今回の場合は、「2012/11」と取った値から「/」を「」に置換して

　　　「201211」の形にした

　※4

　　＝「シート.Move After:=[ブック.]Sheets([ブック.]Worksheets.Count)」

　　　・・・シート.Move　　：　シートを移動する

　　　・・・After:=シート　：　以降で指定したシートの後ろ

　　　・・・Sheets(Worksheets.Count）　：　最後のシート

　※5

　　＝シートが1枚減ったので、その分のカウントを削っている

　※6

　　＝「ブック.Close SaveChanges:=True, Filename := ファイル名」

　　　・・・SaveChanges　：　保存して閉じるか否か

　　　・・・Filename　　：　名前をつけて保存する場合のファイル名

　　　2行にするなら「WB2.SaveAs MyFile（保存）」→「WB2.Close（閉じる）」

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

以上が「月が替わったら前月のシートを全て新しいブックに移す」でした。

もう少しスマートなやり方があるかもしれませんので、実際にお試しの方は

内容に合わせて改変してみてください。

また、今回はいちいち日付を選ぶやり方ですが、
その内「○月」と指定したらその月分を抜き出す方法を
出そうと思います（そちらもやり方はあるので）

では今回はこの辺りで。