エクセルVBAで、テキストボックスに値を入れる（３）

Question

質問がバラバラになってしまってすみません！
エクセルVBAで、テキストボックスに値を入れる（１）の 回答13で、
データシートの何行目～何行目までを印刷させる方法（Sheet7にボタン）
をさせるには、どうしたら良いでしょうか？宜しくお願いします。

前回のURL：http://oshiete1.goo.ne.jp/kotaeru.php3?qid=79173
　　　　 　http://oshiete1.goo.ne.jp/kotaeru.php3?qid=85389

nishi6 · Answer

シート７にボタンを１つ作成します。ＶＢＡのコントロールツールボックス（トンカチとスパナみたいなアイコン）のコマンドボタンです。

コマンドボタンをダブルクリックして、ＶＢＥ画面のシート７のシートモジュールに
下記を貼り付けます。13の回答ではCommandButton1が複数表れるので、3番目のボタンの意味でCommandButton3と書いてしまいました。シート７にコマンドボタン１個の場合はCommandButton1となるはずなので job_Print を書けばおしまいです。

＝＝＝＝印刷シート７のシートモジュールに貼り付け＝＝＝＝＝ 
Private Sub CommandButton1_Click() 
job_Print 
End Sub

nishi6 · Answer

シート７のボタンの機能は、このボタンだけで

　１．パターンの入力
　　　０ならパターン無視(全パターンが印刷対象)
　　　１～５ならそのパターンを印刷
　２．開始行の入力
　　　０なら全行
　　　１以上ならそれが開始行
　３．開始行が１以上なら最終行の入力
　　　０なら最終行を自動設定
　　　１以上ならそれが最終行
の手順とすることで、全パターンまたは指定パターンについて、全頁または指定頁間が印刷可能なように考えました。

したがって、
＞パターン毎に印刷する場合
　　<<パターンの入力＝1、2、3、4または5、開始行の入力＝0>>
　　　　指定したパターンの全行が対象です。当然、指定パターンの開始、最終行
　　　　の入力もできます。

＞データの行を範囲指定して印刷する場合
　　Ｍ行目からＮ行目の場合、
　　<<パターンの入力＝0、開始行＝Ｍ、最終行＝Ｎ>>
　　　　パターンは全パターンになっているので、Ｍ行からＮ行が対象になります。
　　　　蛇足ですが、パターンの入力=0、開始行=0で全データの印刷になります。

説明不足でしたか。

nishi6 · Answer

Select Case の使い方の質問のように思えましたが、違ってる？

Select Caseの使い方に関しては(よく本に書いてあるのが)
　　Select Case Atai
　　　　Case 1: Kekka = "結果A"
　　　　Case 2: Kekka = "結果B"
　　　　　↓
　　　　Case 9: Kekka = "結果Z"
　　End Select
という風に、Ataiという変数が1,2,・・9に従ってKekkaという変数に"結果A"、"結果B"、・・・が入るというように使います。ここで大事なのは、1回の判定ではAtaiは1～9の1つの値しかとらないということです。
Hanteiでの使い方は少し違っていて、
　　Select Case True
　　　　Case Atai = 1: Kekka="結果A"
　　　　Case Atai = 2: Kekka="結果B"
　　　　　↓
　　　　Case Atai = 9: Kekka="結果Z"
　　End Select
としています。各Caseの次の式がTrue（正しい）だったら対応した値がKekkaに入ります。この使い方でも上記と同様に各Caseの次の式が同時にTrueになったら判定がおかしくなります。<Atai = 1>という式は、If Atai = 1 Then で使うように、論理式です。論理式ですから、X=1 And Y=1 AND Z=1 のような使い方ができます。Ifを使うより分かり易い（かな）と思って使いました。

まずい例を上げると、Atai1、Atai2(両者とも0または1とします)で判定する場合、
　　Case Atai1 = 1
　　Case Atai1 = 1 And Atai2 = 1
と書くと、最初の判定でAtai2がどうであれ処理されて、2つ目の式の評価がされないことになります。式の順番を逆にすればうまくいきます。ＶＢＡは上から下に順に処理していくためです。
従って、判定がどう複雑になっても、Caseの次の式がそれぞれ独立ならば正しく判定されます。

しかし、入力は人間が行ったりするのでミスはつきものです。
　（１）各パターンの判定はそれぞれが独立になるように充分検討して設定する
　　　　　まずい例のようになっていないか検証する必要があります。
　（２）入力ミスに備えて、各パターンに該当しなかったデータについても対応する
ことが必要でしょう。（２）については、パターンの判定の最後に、
　　Case Else: MsgBox "パターン判定エラー"
というようにエラー対応し処理を中断できるようにするべきでしょう。

質問の１）、２）、３）については、暫くお待ちを。
自分で改良できるのは、分かってきた証拠でしょう。頑張って下さい。

nishi6 · Answer

>２）終了ボタン～Sheet7に配置～ 
ここでは、メニュー（終了できる方）を「OkWeb_Menu.xls」
データシートを「OkWeb_Data.xls」とします。（ご自分のファイル名に変えてください）
　　１．タイトルバーの左のアイコンのクリック、
　　２．タイトルバーの右クリック
　　３．タイトルバーの×ボタン、
　　４．メニュー→閉じる、
　　５．ブックの× では閉じれなくする

データシートのThisWorkBookのシートモジュールに貼り付けます。
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If Workbooks("OkWeb_Menu.xls").saveOk = False Then
        MsgBox "メニューから終了させてください！", vbOKOnly
        Cancel = True
    Else
        ActiveWorkbook.Save
    End If
End Sub

メニュー（終了できる方）のThisWorkBookのシートモジュールに貼り付けます。
Public saveOk As Boolean     '終了ボタンでTrue

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If saveOk = False Then
        MsgBox "終了ボタンをクリックしてから終了させてください！", vbOKOnly
        Cancel = True
    Else
        Cancel = False
    End If
End Sub

メニューの終了ボタンがあるシートのシートモジュールに貼り付けます。
Private Sub cmdSyuryo_Click()
    Dim myMsg As String
    myMsg = "データシートとフォームのシートを保存して終了します。"
    If MsgBox(myMsg, vbOKCancel, "確認") = vbCancel Then
        Exit Sub
    End If
    Workbooks("OkWeb_Menu.xls").saveOk = True
    Workbooks("OkWeb_Data.xls").Close saveChanges:=True
    ActiveWorkbook.Save
    Application.Quit
End Sub

仮のファイルかコピーを作って試してください。一旦保存しないと効力を発揮しません。
データシートを単独に保存できなくするのは簡単ですが、メニューから保存指示すると、データシートの保存不可機能が働いて、データシートが保存できなくなるため、メニューからの指示ならＯＫという条件付にするのにブック間のモジュールレベルの変数の参照が可能か調べていました。結果はいたって単純でした。勉強になりました。

>３）前回の続きから始める～Sheet7に配置～
これは、メニューを保存（上の２）したので（すれば）、ご自分で作られた「1行前を表示」ボタンか次のデータを表示すれば自然に表示されます。

>１）検索ボタン～Sheet7に配置～
これはＢ列に同じ値があるんですよね。（連続検索）
明日にでも・・・（窓が全部閉じてるかと思いました。ここは明けておいて下さい）

nishi6 · Answer

>１）検索ボタン～Sheet7に配置～ 

標準モジュールの最初(Publicがある場所、Public Sub・・・ の前)に貼り付け 
Public strAdr, endAdr As String       '検索開始、最終アドレス
Public mySearch As String             '検索文字

標準モジュールに貼り付け
'*** 検索 ***
Public Sub Kensaku()
    Dim wbAcv As String                'メニューブック名
    Dim wsDat As Worksheet             'データシート名
    Dim foundCell As Range             '検索結果
    Const topAdr = "$B$1"              '検索開始位置
    
    wbAcv = ActiveWorkbook.Name
    Set wsDat = Workbooks(wbNM).Worksheets(wsNM)
    If Len(strAdr) = 0 Then strAdr = topAdr
    endAdr = Left(topAdr, 2) & "$" & wsDat.UsedRange.Rows.Count
    If Len(mySearch) <> 0 Then
        If MsgBox("継続しますか？(新規はキャンセル)", vbOKCancel, "継続") = vbCancel Then
            mySearch = InputBox("検索文字を入力して下さい。"): If Len(mySearch) = 0 Then Exit Sub
            strAdr = topAdr
        End If
    Else
        mySearch = InputBox("検索文字を入力して下さい。"): If Len(mySearch) = 0 Then Exit Sub
        strAdr = topAdr
    End If
    Application.ScreenUpdating = False
        wsDat.Activate: wsDat.Range(strAdr & ":" & endAdr).Select   '検索範囲
        Set foundCell = Selection.Find(mySearch)                    '検索実行
        Workbooks(wbAcv).Worksheets("Sheet7").Activate
        If foundCell Is Nothing Then                                '検索文字無し
            strAdr = topAdr: MsgBox "検索文字：" & mySearch & "は見つかりません。"
        ElseIf foundCell.Address = strAdr Then                      '全検索終了
            strAdr = topAdr: MsgBox "検索は終了しました。"
        Else                                                        '検索文字発見
            MsgBox "検索文字：" & mySearch & "は " & StrConv((foundCell.Row - 1), vbWide) & "行目 です。"
            strAdr = foundCell.Address
            Tensou foundCell.Row - 1, 0                             '対象シートを表示
        End If
    Application.ScreenUpdating = True
End Sub

シート7のシートモジュールに貼り付け。検索ボタンのオブジェクト名=cmdKensaku
Private Sub cmdKensaku_Click()
    Kensaku
End Sub

連続して検索できるはずです。

nishi6 · Answer

各テキストボックスにはmyText・・・と名前が付いていることを前提にしています。

Sheet1にコントロールツールボックスからトグルボタンを１つ配置します。
オブジェクト名=togWakuView、Caption="枠を非表示"、Value=False にします。
これをコピーして、Sheet2～Sheet5に貼り付けます。

次を標準モジュールに貼り付けます。
'*** 枠の表示切替 ***
Public Sub WakuView(vwSht As Integer, OnOrOff As Boolean)
    Dim shp As Shape
    For Each shp In Worksheets("Sheet" & vwSht).Shapes
        If Left(shp.Name, 6) = "myText" Then
            shp.Select
            Selection.ShapeRange.Line.Visible = OnOrOff
        End If
    Next
End Sub

Sheet1～Sheet5のシートモジュールに貼り付けます。
Private Sub togWakuView_Click()
    If togWakuView = False Then
        WakuView Right(Me.Name, 1), True
        togWakuView.Caption = "枠を非表示"
    Else
        WakuView Right(Me.Name, 1), False
        togWakuView.Caption = "枠を表示"
    End If
    Range(togWakuView.TopLeftCell.Address).Select
End Sub

トグルボタンを押す毎にテキストボックスの枠の表示・非表示が切り替わります。
こういう主旨でした？

nishi6 · Answer

＞印刷時がダメでした！ 表示しているときは、印刷されてしまいます。これはしょうがないですかね！何かよい方法があったらお願いします。

今、モジュールがどう変わっているか分かりませんので想像ですが、 page_Print に２行追加してみて下さい。
印刷時、枠を非表示にして印刷するはずです。

Public Sub page_Print(sPatt, iPatt As Integer) 
Dim myMsg As String 'メセージ 
If iPatt = 0 Then 
myMsg = (Worksheets("Sheet1").Range("B5") - 1) & " 行目" & vbLf 
myMsg = myMsg & "印刷パターン " & StrConv(sPatt, vbWide) & " を印刷します。" & vbLf 
myMsg = myMsg & "　　用紙をセットしてください。" & vbLf & vbLf 
myMsg = myMsg & "（印刷しない場合はキャンセルを押します。）" & vbLf & vbLf 
If MsgBox(myMsg, vbOKCancel) = vbCancel Then 
Exit Sub 
End If 
End If 

    WakuView sPatt, False   '******* 追加 *******

Range("Print_Area").Select: Selection.Font.ColorIndex = 2 
ActiveWindow.SelectedSheets.PrintPreview 'PrintOut 
Selection.Font.ColorIndex = xlAutomatic 
Range("Print_Area").Cells(1, 1).Select 

    WakuView sPatt, True   '******* 追加 *******

End Sub

nishi6 · Answer

回答した、「job_Print」と「page_Print」が今どのようになっているか補足して下さい。すぐ答えはでると思います。
なお、job_Printのメッセージボックス部分は不要です。（あってもいいですが）

nishi6 · Answer

原因が分かりました。

rurucomさんが試されたのは、「エクセルＶＢＡで、テキストボックスにセルの値を入れる」で回答したANo.#13のようです。私はANo.#１４でＯＫと思い、「エクセルＶＢＡで、テキストボックスにセルの値を入れる(３)」のANo.#7では、ANo.#１４の印刷ＶＢＡを想定して書いています。
問題無ければ修正版のANo.#１４で試して下さい。

少し説明を・・・・
ANo.#１４の印刷ルーティンは各シートから呼び出したり、一括指示等をしたいということなので
　　Public Sub page_Print(sPatt, iPatt As Integer) 
に修正しました。
　sPattは印刷パターン（＝シート番号）
　iPattは各シートから印刷する時は印刷パターン、一括指示する時はゼロ（全部の意味）です。
　こうやって、iPattでＶＢＡ内部で処理を分岐させています。　

WakuView sPatt, False は
　sPattは印刷パターン（＝シート番号）
　Falseは線を消す
WakuView sPatt, True 
　True は線を表示する意味です。

印刷時うまくいっていれば、シート番号はsPattで分かっているので、WakuViewを使って印刷前に強制的に線を消して印刷後線を表示できると考えています。多分、ANo.#１４に２行追加でうまくいくと思います。

nishi6 · Answer

挿入する２行を
WakuView Val(sPatt), False
WakuView Val(sPatt), True 
としてみてください。

エクセルVBAで、テキストボックスに値を入れる（３）

シート７にボタンを１つ作成します。

この回答への補足

シート７のボタンの機能は、このボタンだけで

この回答への補足

Select Case の使い方の質問のように思えましたが、違ってる？

この回答への補足

>２）終了ボタン～Sheet7に配置～

>１）検索ボタン～Sheet7に配置～

この回答への補足

各テキストボックスにはmyText・・・と名前が付いていることを前提にしています。

この回答への補足

＞印刷時がダメでした！ 表示しているときは、印刷されてしまいます。

この回答への補足

回答した、「job_Print」と「page_Print」が今どのようになっているか補足して下さい。

この回答への補足

原因が分かりました。

この回答への補足

挿入する２行を

この回答への補足

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

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

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

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

＞印刷時がダメでした！表示しているときは、印刷されてしまいます。