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

質問

宜しくお願いします。

エクセルデータの各項目を、すでに書式（表）が印刷された用紙のそれぞれの項目の位置に印刷させたいのですが・・・

各項目には、500行ぐらいのデータがあり、別のワークシートの表示させたい位置（すでに印刷された用紙にあわせてある）に各項目ごとのテキストボックスを作っておいて、そのテキストボックスに各項目のデータを1行ごとに表示させて、テキストボックスのフォント調整、印刷　～を繰り返したいのですが、どのようなコードを書けばよいのでしょうか？

進め方としては、データシートからテキストボックスに各項目のデータが表示されたら、シート上でテキストボックスのフォントや位置の微調整が出来るようにしておいて、印刷ボタンをクリックすると印刷され、次へのボタンをクリックすると、次の行のデータがテキストボックスに表示されるようにしたい。

※印刷する場合は、テキストボックス内の文字のみ印刷（シートには印刷したくない文字書きたいので・・・）

また、そのフォームには、パターンが５つあって、データには1行ごとにパターン番号が入力されているとして、それぞれのパターンにあわせたテキストボックスの配置してあるシートへ行くようにもしたい。

データの入れ替わりが多いので、別のワークブックと繋がるような仕組みにしておいて、テキストボックスの配置してあるブック側から、データのあるブックを呼びに行ってデータを取りに行くようにしておきたい。

以上、条件が多くてすみませんが、VBAは初心者で、ほんの部分的にしかまだ分かりません。どなたか詳しい方宜しくお願いします。

回答No.14

nishi6 · ベストアンサー

前回の解答はプレビューで確認し、プレビュー画面の印刷ボタンを押せば印刷しますが、プレビュー画面を表示しないで直接印刷する場合は、単票印刷の書式覚えておく必要があります。
下記の修正は、印刷時にどのパターンの単票が必要かを知らせます。メッセージ表示のタイミングは、特定の印刷パターンを指定した時は印刷時最初のみ、全パターン指定時は各データ印刷毎です。特定の印刷パターンを指定すれば用紙をまとめてセットできるので実務的と思われます。

●**** 追加 ****　と書いた範囲を追加、**** 修正 **** の１行を修正
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
'**** 追加 ****　↑

Range("Print_Area").Select: Selection.Font.ColorIndex = 2
ActiveWindow.SelectedSheets.PrintPreview 'PrintOut
Selection.Font.ColorIndex = xlAutomatic
Range("Print_Area").Cells(1, 1).Select

End Sub

●**** 追加 ****　と書いた範囲を追加、**** 修正 **** の１行を修正
Public Sub job_Print() '指定して連続印刷
：
Application.ScreenUpdating = False
'**** 追加 ****　↓
If prtPattern <> 0 Then
myMsg = "印刷パターン " & StrConv(prtPattern, vbWide) & " を印刷します。" & vbLf
myMsg = myMsg & "　　用紙を複数枚セットしてください。"
MsgBox myMsg, vbOKOnly
End If
'**** 追加 ****　↑
For rowCot = startRow To endRow '連続ページ印刷
Tensou rowCot, prtPattern
If prtPattern = 0 Or (prtPattern = shtPatt) Then '印刷パターンを判定
page_Print shtPatt, prtPattern '**** 修正 ****
End If
Next
Application.ScreenUpdating = True
Worksheets("Sheet7").Activate
End Sub

●**** 修正 ****の１行を修正（５シート同様に修正）
Private Sub CommandButton2_Click() 'シート単位の1ページ印刷ボタン
page_Print Right(ActiveSheet.Name, 1), 0 '**** 修正 ****
End Sub

お礼

nishi6さん、長い間ありがとうございました。何と素晴らしいものになりつつあります。
あと、何点か質問があるのですが・・・補足を書く事が出来なくなってしまったので、質問にエクセルＶＢＡで、テキストボックスにセルの値を入れる（２）で新たに質問させていただきますので、宜しくお願いします。

補足

nishi6さん！ありがとうございます。早速、やってみます！明日にでも結果ご連絡します。

回答No.13

nishi6

最初に誤っておかないと・・・・
Hanteiはデータシートを見ていませんでした。頭の中だけで書いたもので、すいませんでした。最初から作り直しました。テストもしています。
それから、うまくいったとしてもデータの書き込みとテキストボックスの更新が同期が取れない時があるようです。

下記に全てをまとめました。「***」部分はご自分の内容に変更して下さい。連続印刷はシートの機能を使うようにしたため、全体的に手を加えています。コピーして貼り付けて下さい。
印刷パターン(全部、個別)×印刷行範囲(全体、指定)が可能です。
「0」を特別な意味に使っていますがダイアログのコメントを見て下さい。回答が長くなるので入力値は最小限のチェックしかしていません。強化してください。(文字はダメとか)
Sheet1～5にデータ転送用のボタンと印刷用のボタン、Sheet7に連続印刷ボタンがあり、オブジェクト名は順にCommandButton1、2、3です。
うまく動くといいですが。(十分確かめてください)

＝＝＝＝印刷シートの標準モジュールに貼り付け＝＝＝＝＝
Public Const wbNM = "OKWEB_SorceData.xls" '***データがあるブック名
Public Const wsNM = "Sheet1" '***データがあるシート名
Public cl As Integer 'データの列カウンタ
Public shtPatt As Integer 'データから評価したシートのパターン
Public st As Integer '印刷するシートのカウンタ

Public Sub Tensou(TensouNo As Long, shtNo As Integer) 'データをシートに書く、変更あり
With Workbooks(wbNM).Worksheets(wsNM).Range("A1")
shtPatt = Hantei(TensouNo): If shtPatt = 0 Then Exit Sub
If shtNo = 0 Or shtNo = shtPatt Then
Worksheets("Sheet" & shtPatt).Activate 'パターンのシートをアクティブにする
For cl = 0 To 4 '***データはA～E列にあると想定
DoEvents
ActiveSheet.Range("A1").Offset(1, cl) = .Offset(TensouNo, cl)
Next
DoEvents
Worksheets("Sheet" & shtPatt).Calculate
For st = 1 To 5 '次に転送するデータ行を各シートに書き込み
Worksheets("Sheet" & st).Range("B5") = TensouNo + 1
Next
End If
End With
End Sub

Public Function Hantei(rowNo As Long) '各Case の次は例です。変更してください
With Workbooks(wbNM).Worksheets(wsNM) 'この間違いが致命的でした
Hantei = 0
Select Case True 'Rangeの前にはピリオドあり
Case .Range("A" & rowNo + 1) <> "" And .Range("B" & rowNo + 1) <> ""
Hantei = 1
　　　　　　　　　↓　この部分は省略！
Hantei = 5
End Select
End With
End Function

Public Sub job_Print() '指定して連続印刷
Dim myMsg As String 'メセージ
Dim myNum 'インプット帰り値
Dim prtPattern As Integer '印刷パターン、0は全て
Dim startRow As Long '印刷開始行、0は開始、最終行を自動計算
Dim endRow As Long '印刷最終行、0は最終行を自動計算
Dim rowCot As Long '行カウンタ

myMsg = "印刷パターンを入力（0から5）" & vbLf & "　　＜0(ゼロ)は全種類＞"
myNum = InputBox(myMsg): If Len(myNum) = 0 Then Exit Sub Else prtPattern = Val(myNum)
If InStr("012345", prtPattern) = 0 Then MsgBox "エラー": Exit Sub
myMsg = "印刷開始行を入力" & vbLf & "　　＜0(ゼロ)は全データ＞"
myNum = InputBox(myMsg): If Len(myNum) = 0 Then Exit Sub Else startRow = Val(myNum)
If startRow = 0 Then
startRow = 1
endRow = Workbooks(wbNM).Worksheets(wsNM).UsedRange.Rows.Count - 1
ElseIf startRow >= 1 Then
myMsg = "印刷最終行を入力" & vbLf & "　　＜0(ゼロ)は最終行＞"
myNum = InputBox(myMsg): If Len(myNum) = 0 Then Exit Sub Else endRow = Val(myNum)
If endRow = 0 Then
endRow = Workbooks(wbNM).Worksheets(wsNM).UsedRange.Rows.Count - 1
End If
Else
MsgBox "エラー": Exit Sub
End If

Application.ScreenUpdating = False
For rowCot = startRow To endRow '連続ページ印刷
Range("A2") = rowCot
Tensou rowCot, prtPattern
If prtPattern = 0 Or (prtPattern = shtPatt) Then '印刷パターンを判定
page_Print
End If
Next
Application.ScreenUpdating = True
Worksheets("Sheet7").Activate
End Sub

Public Sub page_Print() '単ページ印刷、変更しています
Range("Print_Area").Select: Selection.Font.ColorIndex = 2
ActiveWindow.SelectedSheets.PrintPreview 'PrintOut
Selection.Font.ColorIndex = xlAutomatic
Range("Print_Area").Cells(1, 1).Select
End Sub

＝＝＝＝印刷シートの各シートモジュールに貼り付け（５シートとも）＝＝＝＝＝
Private Sub CommandButton1_Click() 'データ転送ボタン、変更しています
Tensou Range("B5") - (Range("B5") = 0), 0
End Sub

Private Sub CommandButton2_Click() 'シート単位の1ページ印刷ボタン
page_Print
End Sub

＝＝＝＝印刷シート７のシートモジュールに貼り付け＝＝＝＝＝
Private Sub CommandButton3_Click()
job_Print
End Sub

お礼

すみません！印刷範囲を設定するのを忘れていました！うまくいきました！

補足

補足が前後してしまいすみません！
エラーです！
実行時に'1004':'Range'メゾットは失敗しました'Global'オブジェクト

この部分で止まります！なぜでしょうか？
ここから→Range("Print_Area").←（デバック）Select: Selection.Font.ColorIndex = 2
ActiveWindow.SelectedSheets.PrintPreview 'PrintOut
Selection.Font.ColorIndex = xlAutomatic
Range("Print_Area").Cells(1, 1).Select

＞それから、うまくいったとしても・・・
その場合どのように対処したら良いのでしょうか？
次を表示させる部分では、今のところうまくいってます。
よろしくお願いします。

回答No.12

nishi6

解決したでしょうか。

確認ですが、各モジュールの先頭に「Option Explicit」はありますか？
変数の宣言を強制するもので、ＶＢＥ画面で、ツール→オプション→編集タブの変数の宣言を強制する、にチェックを入れておくと自動的に出てきます。スペルミス等を発見するのに役立ちます。無ければ、各モジュールの先頭に書いてマクロを実行してみてください。何かわかるかも。。。

それから、カウンタに使っている(B5)セルの値はボタンを押すと＋１されますか？

また、状況がわかりませんので、作成されたHanteiとデータを数行、補足で示してもらえば何かわかるかもしれません。

＞それと、（いろいろすみません） ・・・・もお願いします。贅沢言ってすみません！
そう面倒ないと思いますので次回に回答します。

補足

解決していません！
＞先頭に「Option Explicit」はありますか？
→あります。

＞(B5)セルの値はボタンを押すと＋１されますか？
→3行目まではされます。と言うか、2行目が最初のデータで3行目は次です。だから1回しか出来ていないてことですよね？

＞作成されたHantei
→4つのパターンに絞りました。現在テストデータでしてますが、下記の表に合わせるをこんな感じです。
Select Case True
Case Range("D" & rowNo) <> "" And Range("F" & rowNo) <> ""
Hantei = 1
Case Range("D" & rowNo) <> "" And Range("G" & rowNo) <> ""
Hantei = 2
Case Range("G" & rowNo) <> ""
Hantei = 3
Case Range("D" & rowNo) <> ""
Hantei = 4

＞データを数行 との事ですが、
顧客名簿の為ここにかけませんが下記のような感じです。
ボタン｜NO.｜コード｜会社名｜部署｜役職｜氏名１｜氏名２｜郵便番号｜住所１｜２｜３｜TEL｜FAX｜Mail｜備考｜
｜ １ ｜１２３｜株式会社○｜ ｜社長｜太郎｜ ｜ ｜ ｜1234567｜日本｜ ｜ ｜ ｜ ｜ ｜ ｜

上記ような顧客名簿から、会社名、役職、氏名の欄にデータがあるかないかで、個人なのか法人なのかを認識させるなどが、今まで言ってたパターン番号なのです。
7行目までは、同じパターンですが3行目までしか動きません。

テストデータ（5列10行程度）でもう1回はじめからやっているのですが、今度はまったく動かなくなりました。（がーん！？！？！？！？）
それで、最初のデータ側にコーディングしたときはうまくいったので、やっぱりデータ側に書く事にします。というのが…データ側のファイルのA１のところにボタンを作ってフォーム側のSheet1が開くようにしたので、それと同時にパターンの行に”＝Hantei（row（））をデータの行数分返すようなしくみにしようと思ってます。
データが変わる場合は、A2からデータの範囲をコピー＆ペーストで処理しようと思います。
で…今下記のように、
Private Sub CommandButton1_Click()
Dim rw As Integer
rw = Range("D2").End(xlDown).Row
Dim Pt As Integer
Pt = '→ここに[＝Hantei（row())]を入れる方法が分かりません！
Range(Cells(2, 5), Cells(rw, 5)) = Pt
Workbooks("本体.xls").Worksheets("Sheet1").Activate
MsgBox ("成功" & rw)
End Sub
こんな感じで、データ行数を調べるとこまできてますが、あと＝Hantei（row())を返す方法を教えてください。頑張ってここまできましたが、多分元から変えないとだめなんじゃないかなぁ…そんな気がしますがいかがでしょうか？ よろしくお願いします。

回答No.11

nishi6

＞上記のコードをデータシートのモジュールに書いていたんですが、操作する側のファイル（回答４を書いているファイル）に書かないといけないんですよね？？？

Public Function Hantei(rowNo As Long) ～　は５枚の印刷用シートがあるxlsファイルに書きます。書く箇所は、標準モジュールを挿入して、これに書きます。

データシートができていれば、処理の理屈は、
●印刷側のどこかのシートで最初作成したボタンを押します。　→　以下はVBAです
　　この時、B5セルを参照してデータシートの該当行データを参照。
　　データシートのA～D列の内容をユーザー定義関数Hanteiで評価して
　　シートを特定します。<※>
　　特定したシートにデータを書き込み、そのシートをアクティブにします。
●人が見て微調整します。
●印刷ボタンを押します。　→　以下はVBAです
　　セルの文字を消して印刷。済んだら元に戻す。
　　次の処理のために行カウンタ(B5)を進める。
ユーザー定義関数は<※>で使用しています。

５枚の印刷用シートには各シートに
　（コードはまったく同じです。コードをコピーしても可）
最初のボタンと
　#4 の　Private Sub CommandButton1_Click()　～
を各シートのコードウインドウに
印刷ボタンと
　#5 の　Private Sub CommandButton2_Click() ～
を各シートのコードウインドウに書きます。

挿入した標準モジュールには
#4 の　Public Const wbNM = "OKWEB_Data.xls" ～
#5 の　Public Function Hantei(rowNo As Long) ～
を書きます。
データシートには何も書きません。

補足

nihsi6さん！ありがとうございます。
ほんとにすみません！私の勘違いというより理解していなかったようです。
処理の理屈をおしえていただいて分かりました。
で、早速やってみました！ＯＫです。しかし・・・またもやすみません！
次を表示するで3行目まで行ってそれから先に動きません！なぜでしょう？？？？？
パターンの条件は9行目まで同じなのに・・・・・（私ももう少しじっくり考えてみます）何かヒントがありましたらお願いします。

　それから、いままでデータのシートにパターン番号があることを想定して、Sheet7に一括印刷ボタンを作って、ARCさんの＃7を参考に作ってたんですが・・・
nishi6さんの方法（データシートにパターンが表示されない方）で一括印刷をさせたくて、考えていたらまたもや？？？？？？？？？？？？？？状態です。　すみません、一括印刷（全データを行の順に1行目～最後まで）の仕方も教えていただけませんでしょうか？

それと、（いろいろすみません）
１）何行目～何行目までを印刷させる方法（Sheet7にボタン）
２）パターン番号を指定して、そのフォームだけを印刷させる方法（Sheet7にボタン）
　　　　　　もお願いします。贅沢言ってすみません！

しかし、nishi6さんは、すごいですね！アッというまにこんなコーディングが出来るなんて、しかも丁寧に！ここまでなるのにどれくらい（期間）かかったのですか？どうやって勉強したんですか？
私は、いろいろな本を読んだり、ホームページで参考になるところをみたりしながら勉強しているんですが、なかんか理解できなくて・・・（泣）Uｕ・・・
今回も、ちょっと分かってきたかなって思ってたらやっぱり理解できてなくって、またNishi6さんに迷惑かけてしまい、すみません。
なんだか、自信がなくなってきました！　　うん？でも、まだあきらめたわけではありません！　実践あるのみ！と思ってがんばってます。とは言ったものの（すみません！私の実践につき合わせてしまって・・・）
　この前は、自分でつっくたファイル（VBA）が“ウィルスが発見されました！”ってでてきてまいりました！（がーん！）
　早く、コーディングが出来るようになりたいと思う毎日です。勉強方法も何かアドバイスがありましたらお願いします。

回答No.10

nishi6

＞問題は、OKWEBが漏れていた事と・・・・
少し誤解があるようなので説明します。「OKWEB_Data.xls」は私が作った勝手なファイル名ですのでrurucomさんが作られたファイル名をこの名前にする必要はありません。逆にマクロ内の「OKWEB_Data.xls」をrurucomさん使用のファイル名に変えてくださいという意味でした。それはさておき（動いたということで）

＞＝Hantei（Row())をE列に設定をデータ行数に合わせて自動的に、返してくれる方法はありませんか

に対するア）の方法ですが、判定条件さえ確実ならデータシートの方に手を加えることは必要ないと思います。行を指定したときに、パターンを判定すれば済むことで、下記の修正を加えれば大丈夫でしょう。

ユーザー定義関数を少し変えます。標準モジュールにあることが必要です。２行を追加します。
Hantei = 5
Case Else '***追加***　パターンに合わない場合、データが無くなった場合
Hantei = 0 '***追加***
End Select

#4に書いたモジュールを少し変えます。
st = .Offset(tensouNo, pattIdx - 1): If st = 0 Then Exit Sub 'パターンを調べる
　　　↓
st = Hantei(tensouNo): If st = 0 Then Exit Sub 'パターンを調べる
都合3箇所の修正です。

　1)どこかの印刷用シートの<Ｂ5に印刷行を入力>（未入力なら1）
　2)<ボタン１を押す>
　3)パターンを判定して該当のシートを表示、データを２行目に転送
　4)<テキストボックスの微調整>
　5)<印刷ボタンを押す。>シートの文字を見えなくして印刷。
　6)印刷が終わればシートの文字を可視に
　7)繰り返し　　　の手順になるはずです。<　>は人の操作です。
テスト用に作ったシートを消してしまいました。想像だけで書いていますので不具合があれば教えてください。

補足

nishi6さん！ほんとに何度もすみません！
私は、どうやら勘違いしていたような・・・

Public Function Hantei(rowNo As Long)
Application.Volatile
Select Case True
Case Range("A" & rowNo) <> "" And Range("B" & rowNo) <> ""
Hantei = 1
↓ここからここまで
Case Range("A" & rowNo) <> "" And Range("B" & rowNo) <> "" And Range("C" & rowNo) <> ""
Hantei = 5
Case Else
Hantei = 0
End Select
End Function

上記のコードをデータシートのモジュールに書いていたんですが、操作する側のファイル（回答４を書いているファイル）に書かないといけないんですよね？？？

それしたら、どこに書いて良いか分からなくなってきたのですが・・・

ほんっ・・とに何度もすみません。どこに書いたら良いか教えてください。

回答No.9

TTak

No.3の補足での問題を要約すると
(1)データが4桁の数値で、それぞれの桁ごとにテキストボックスに数値を表示した
い。
(2)データ数（行数）の増減に対応したい。（数値の無い所ではエラーとなる）
(3)計算にかかる時間を減らしたい。
ということでしょうか。

(1)については、すでにMIDワークシート関数で試されているようでが、これとINDEX関数を組み合わせれば、当該回答で述べた応用が利くと思います。A列の2～500行目までの4桁数値のデータがあり、B1に行番号（インデックス値）があるとするならば、
=MID(INDEX($A2:$A500,$B$1),X,1)
ですね。X=1で1桁目、X=2で2桁目～X=4で4桁目を表示します。
(2)INDEX関数で指定するデータ範囲を多めにしておいて、"#REF!"エラーになったら表示しない方法と、（スピン）ボタンの最大値をVBAで入れる方法があります。
=IF(ISERR(Y)=TRUE,"",Y)
この例ではYが"#REF!"ならば空白になります。
スピンボタンの最大値をVBAで固定する場合、X列目のデータが何行目まであるかを取得するには、
Range(.Cells(Rows.Count, X).End(xlUp).Address).Row
を使ってはいかがでしょう？
(3)計算時間が長くなるということは、リンク付きのテキストボックスの数が結構多いんじゃないですか？。オプションで計算を手動にすると、いちいち計算のたびに作業が止まらなくて済みますが、得策ではないかもしれません。やはり、セルを調整していった方がいいのかもしれませんが、印刷時の位置ズレに関しては、EXCELはあまり向いていないのかもしれませんね。
・・・なんか、以前私が直面してきたことと同じ道を歩んでいらっしゃるようです(^^;)。がんばってください。私の所は、伝票印刷用のソフトを入れました。

お礼

TTakさん！ありがとうございました。
なるほど！INDEX関数だったんですね！ほんとにありがとうございました。

回答No.8

nishi6

＞Ａ・Ｂ・Ｃ）のように３つ列にデータがある場合がうまくいきません・・・
３個の場合も同様と思って分けなかったんですが、
Case Range("A" & rowNo) <> "" And Range("B" & rowNo) <> "" And Range("C" & rowNo) <> ""
のように書きますが、最初に(A,B)で判定して、次に(A,B,C)で判定すると、集合論的に言うと(A,B)⊃(A,B,C)となっているため、望む答えが得られないことになります。各判定(Caseの後ろの式)を独立にすることが大事です。(A,B)はC列に入力されていないことなら And Range("C" & rowNo) = "" を追加します。

＞＃４の回答で教えていただいたＶＢＡが、インデックスが見当たりませんのエラー
Public Const wbNM = "OKWEB_Data.xls" をご自分のブック名にされました？
Public Const wsNM = "Sheet1" をデータがあるシート名にされたでしょうか。
私は、１つのExcelに２のブックを開いて確認しました。同様にしてもらえませんか。またスペルミスの可能性はありませんか。OKWebをコピーされましたか。やはり見えないといろいろ起きますね。

＞LinkedCellのセル番地をセットが良く分かりませんでした
そのテキストボックスに表示したいセル番地をセットします。#4では２行目にデータを出力していましたので、A2とかB2になります。

＞＝Hantei（Row())をE列に設定をデータ行数に合わせて自動的に、返してくれる方法はありませんか？
「データ行数に合わせて自動的に、返してくれる」の意味が良くわかりませんが、何かのキッカケでＥ列にこの式が自動的にセットされるということでしょうか。
ア）AからDまでのどこかに入力されたらE列に式をセットして評価
イ）AからDまで何件も入力しておいてマクロを実行して一括セット（コピー）
他にも考えられますし補足して下さい。ア）、イ）は可能です。

補足

nishi6さん！うごきました！くだらない質問をしてしまいすみません！
問題は、OKWEBが漏れていた事と、次に(A,B,C)で判定すると、集合論的に言うと(A,B)⊃(A,B,C)となっていたためでした。

＞「データ行数に合わせて自動的に、返してくれる」の意味が良くわかりませんが
の件ですが・・・説明が悪くてすみません！
ァ）の方がいいように思うのですが・・・
データファイルの行数がどれぐらいになるかがその時々で変わってくるのです。私自身がこの作業を常にやっていれば問題ないのですが、いろんな人（ド素人）が作業を変わりばんこにしますので、自動的に認識させたいのです。

できれば、データファイルの方にプログラムを記述するのではなく、フォームのあるファイルの方で実行させたいのですが、出来ますか？
なぜかというと・・・
データファイルにコーディングしたりSheet１のＥ列に数式を入れておくと別のデータに変わったプログラミングしなければならない。というのをなくしたいのです。
既存のデータの数多くあるので・・・

回答No.7

ARC

Private Sub 印刷ボタン_Click()
　　Dim DataRange As Range
　　Dim RNG As Range
　　Dim RowNo As Long
　　Dim TargetSheetName As String
　　Dim OTargetSheetName As String
　　Dim ExitFlag As Boolean

　　Const CriteriaColumn = "B" '帳票を判別するためのキーとなる列を設定します。
　　'例えば、"B"を設定すれば、B列の内容に応じて帳票を切り替えます。

　　Set DataRange = Range("A2..Z65536") 'データが入力されている範囲を設定します。

　　For Each RNG In DataRange.Rows
　　　　RowNo = RNG.Row
　　　　Select Case Range(CriteriaColumn & RowNo)
　　　　　　Case 1 'B列の値が１ならば、Sheet2の帳票を印刷する。
　　　　　　　　TargetSheetName = "Sheet2"
　　　　　　Case 2
　　　　　　　　TargetSheetName = "Sheet3"
　　　　　　Case 3
　　　　　　　　TargetSheetName = "Sheet4"
　　　　　　Case ""　'B列が空白ならば、そこで処理を中止する。
　　　　　　　　ExitFlag = True
　　　　　　　　TargetSheetName = ""
　　　　　　Case Else
　　　　　　　　MsgBox "印刷する帳票が識別できませんでした。(" & RowNo & "行目)"
　　　　　　　　TargetSheetName = ""
　　　　End Select

　　　　'エラーチェック
　　　　If TargetSheetName = "" Then GoTo NextRow

　　　　'用紙の準備
　　　　If OTargetSheetName <> TargetSheetName Then
　　　　　　MsgBox "プリンタに用紙 (" & TargetSheetName & ")をセットしてください。" & vbNewLine _
　　　　　　& "準備が出来たら[OK]をクリックしてください。"
　　　　End If

　　　　'印刷
　　　　Worksheets("Sheet5").Range("A1") = RowNo
　　　　Worksheets(TargetSheetName).Calculate
　　　　Worksheets(TargetSheetName).PrintOut
NextRow:
　　　　If ExitFlag Then
　　　　　　Exit For
　　　　End If
　　Next
　　MsgBox "終わり!"

End Sub

補足

ＡＲＣさん！ありがとうございます。うまく動きました！！
このＶＢＡは、一括印刷をさせるボタンとして使わせていただきます。

ところが、現在、各シートを表示させながら1枚ずつ印刷させるＶＢＡのコーディングで悪戦苦闘中で、この辺のところについて教えていただけませんでしょうか？

最初の質問のところで、
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
進め方としては、データシートからテキストボックスに各項目のデータが表示されたら、シート上でテキストボックスのフォントや位置の微調整が出来るようにしておいて、印刷ボタンをクリックすると印刷され、次へのボタンをクリックすると、次の行のデータがテキストボックスに表示されるようにしたい。

※印刷する場合は、テキストボックス内の文字のみ印刷（シートには印刷したくない文字書きたいので・・・）

また、そのフォームには、パターンが５つあって、データには1行ごとにパターン番号が入力されているとして、それぞれのパターンにあわせたテキストボックスの配置してあるシートへ行くようにもしたい。
＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
の部分です。

宜しくお願いします。

回答No.6

ARC

>すみませんが、詳しく教えていただきたいのですが、宜しくお願いします。

#1の回答は忘れてください(汗)。もっとよさそうなやり方を考え付きました。

複数の帳票を使うということですので、ワークシートを複数用意することにしましょう。
とりあえず、Sheet1にデータが入力されていて、使用する帳票が３つ。それぞれSheet2,Sheet3,Sheet4にレイアウトを作成することとします。
また、Sheet5を作業用に使用するものとします。

●まず、任意の列のデータのみを取り出す処理を作成します。
1:Sheet5!A1のセルに「2」と入力
2:Sheet5!A2に「=INDIRECT("Sheet1!A" & $A$1)」(このセルに、Sheet1!A2のセルの内容が取り出せたはずです。)
3:同様に、Sheet5!B2に「=INDIRECT("Sheet1!B" & $A$1)」と入力。これを必要な列の数だけ繰り返す。
(Sheet5!A1の数値を変更すれば、その行のデータが取り出せるはずです。)

●取り出したデータをもとに、帳票のイメージを作成します。
4:Sheet2にテキストボックスを配置して、数式編集欄に「=Sheet5!A2」と入力(テキストボックスにSheet5!A2の内容が表示される)
5:テキストボックスをもう一つ作成し、数式編集欄に「=Sheet5!B2」と入力。これを列の数だけ繰り返す。
6:大まかな帳票の体裁に整える。

●他の帳票のイメージも作成。
6:Sheet5!A1 に行番号を数値で入力し、帳票２のデータを表示させる。
7:Sheet3にもテキストボックスを貼り付ける。数式編集欄に「=Sheet5!A2」と入力。同じ操作を列の数だけ。Sheet2をコピーすれば楽チンかも。
8:Sheet4も同様。

●ユーザーインターフェースの作成(印刷ボタン1コ)
9:[表示]-[ツールバー]-[コントロールツールボックス]
10:Sheet1を選択して、「コマンドボタン」のパーツを配置する。
11:配置したボタンをマウスで選択
12:「コントロールツールボックス」の「プロパティ」をクリック
13:[(オブジェクト名)]の項目を「印刷ボタン」に設定する。
14:[Caption]の項目を、「印刷開始」に設定する。

●ボタンを押したときの処理をVBAで記述する。
15:ボタンをダブルクリック。(VBAの編集画面が登場)
16:後述のコードを記述する。

●実行!!
17:「コントロールツールボックス」の三角定規のアイコンをクリック。
18:「印刷開始」ボタンをクリック。

回答No.5

nishi6

＞この辺でも何かアドバイスがありましたらよろしくお願いします。
思いつくままに・・・・（よく同じようなことをしているもので）
１．用紙換えが大変でしょうからデータを事前にパターンでソートしておいたらどうでしょう。
２．ＶＢのテキストボックスで AutoSize が使えるかもしれません。
３．微調整の意味がデータの長さに起因するものなら、２行目にデータを持ってきたら、３行目で例えばA3:=RIGHT(REPT(" ",10)&A2,10) と10桁に揃えてしまえば修正は少なくなるかもしれません。
カンマ付で10桁にするならA3:=RIGHT(REPT(" ",10) & TEXT(A2,"#,#"),10) とか。そしてA3をテキストボックスに表示します。微調整を極力少なくする（なくす）つくりが必要でしょう。
それに、フォントはプロポーショナルは使わないほうがいいかもしれませんね。

＞それと、補足で質問ですが・・・
標準モジュールにユーザー定義関数を定義したらどうでしょうか。
下は(A,B)、(B,C)、(C,D)、(A,C)、(A,D)の列のセットで入力があればパターンを返しています。条件が合うように変更してください。
例えば、Ｅ列に　=Hantei(row()) と設定します。自動再計算します。

Public Function Hantei(rowNo As Long)
Application.Volatile
Select Case True
Case Range("A" & rowNo) <> "" And Range("B" & rowNo) <> ""
Hantei = 1
Case Range("B" & rowNo) <> "" And Range("C" & rowNo) <> ""
Hantei = 2
Case Range("C" & rowNo) <> "" And Range("D" & rowNo) <> ""
Hantei = 3
Case Range("A" & rowNo) <> "" And Range("C" & rowNo) <> ""
Hantei = 4
Case Range("A" & rowNo) <> "" And Range("D" & rowNo) <> ""
Hantei = 5
End Select
End Function

＞印刷する場合は、テキストボックス内の文字のみ印刷（シートには印刷したくない文字書きたいので・・・）
にはまだ回答してませんでした。

Workbook_BeforePrint を使って、セルの色を変えて印刷して戻せばいいと思ったのですが、印刷した後、元に戻すイベントを見つけられませんでした。苦し紛れにボタン(Caption=印刷)を追加しました。
Sheet1～Sheet5にボタン(VBのデス)を追加します。ダブルクリックして、
Private Sub CommandButton2_Click()
Range("Print_Area").Font.ColorIndex = 2　'2で白くなるハズ
ActiveWindow.SelectedSheets.PrintPreview '今は画面表示
'ActiveWindow.SelectedSheets.PrintOut
Range("Print_Area").Font.ColorIndex = xlAutomatic　'黒になるハズ
End Sub
とします。５シートとも同じコードです。
各シートには印刷範囲を設定しておいてください。
それから#4の回答はデータの入ったシートと印刷用のシートが共に開いていることを想定しています。

結局、どのようなコントロールを使用するかは問題ではなく、データをそれに見合ったシートに渡し、印刷時にセル色を制御する問題だったようです。
長くなりました。では。。。

補足

ｎｉｓｈｉ６さん！度々すみません！

パターンを返すＶＢＡはテストデータでは、うまく動きました。ところが・・・
私の補足説明不足のせいでしょうが・・・
Ａ・Ｂ・Ｃ）のように３つ列にデータがある場合がうまくいきません2つまでしかだめなんですか？

それから、＝Hantei（Row())をE列に設定をデータ行数に合わせて自動的に、返してくれる方法はありませんか？

それと、＃４の回答で教えていただいたＶＢＡが、インデックスが見当たりませんのエラーで、デバックにすると、With Workbook（WbNM)．～の行で止まります。
どうしてでしょうか？
LinkedCellのセル番地をセットが良く分かりませんでしたどとりあえずA1と入れました。このせいですかねー？

いろいろとすみません。またまた宜しくお願いします。

回答No.4

nishi6

私は同様のケースではＶＢのツールボックスのコントロールを使っています。
一回、テキストボックスのLinkedCellに設定すればコードが不要になりますし、
元データの加工・変換、演算等がセル上で解決できるからです。(図形も同じ？)

ということで、以下はツールボックスのテキストボックスを使用しています。参考にして下さい。
下記VBAは図形でも同じ理屈で動くはずです。

テキストボックスに表示したい行を２行目に書き込んだとして、(下記ＶＢＡ)
表示→ツールバー→Visual Basic で表示されたテキストボックスを貼り付け、
テキストボックスを右クリックしてプロパティをだし、
　フォントは　　Font で指定
　文字色は　　　FontColor で指定
　枠を消すなら　BackStyle=0、SpecialEffect=0
　テキストの内容は　LinkedCell にセル番地をセット
この時点で基本的な画面設定は終らせておきます。後は微調整ですか。

印刷用のSheet1～Sheet5(シート名はこのままを想定)の各シートにコマンドボタンを配置します。
（表示→ツールバー→Visual Basic のツールボックスのコマンドボタンです。）
編集モードでコマンドボタンをダブルクリックして

Private Sub CommandButton1_Click()
Tensou Range("B5") - (Range("B5") = 0) '未入力なら１件目を転送
End Sub

各シート同じです。

どのデータを印刷するか各シートのセルB5にセットするようにしています。
A5には「次の表示行」と入れておけば分かり易い？ボタンもこの近辺がいい？
データシートは１行目に表題があって２行目からデータがあるものとしています。
印刷は微調整後、印刷のアイコンを押します。

下記を標準モジュールに貼り付けます。
　wbNM にデータが入力されているブック名をセットします。
　wsNM にデータがあるシート名
　pattIdx にデータのパターンが登録されている列(Aが1,B列は2)をセットします。

ところで、この処理は事前に印刷された用紙の穴明き部分に再度印刷するような処理と
思われますが、単票を使い、その都度用紙をセットされるのでしょうか。

Public Const wbNM = "OKWEB_Data.xls" 'データがあるブック名
Public Const wsNM = "Sheet1" 'データがあるシート名
Public cl As Integer 'データの列カウンタ
Public st As Integer '印刷するシートのカウンタ
Public Const pattIdx = 5 'データのパターンが登録されている列(Aが1,これはE列を想定)

'tensouNo で指定された行のデータを該当シートに書き込む
Public Sub Tensou(tensouNo As Long)
'データを印刷用シートに書き込む
With Workbooks(wbNM).Worksheets(wsNM).Range("A1")
st = .Offset(tensouNo, pattIdx - 1): If st = 0 Then Exit Sub 'パターンを調べる
Worksheets("Sheet" & st).Activate 'パターンのシートをアクティブにする
For cl = 0 To 4 '行データを書き込む。データはA～E列にあると想定
ActiveSheet.Range("A1").Offset(1, cl) = .Offset(tensouNo, cl)
Next
End With
'次に転送するデータ行を各シートに書き込み
For st = 1 To 5
Worksheets("Sheet" & st).Range("B5") = tensouNo + 1
Next
End Sub

補足

nishi6さん！こんばんわ！またnishi6さんにはお世話になってしまいました。いつも丁寧なコーディングをありがとうございます。早速、コーディングしてみます。

＞ところで、この処理は事前に印刷された用紙の穴明き部分に再度印刷するような
＞処理と思われますが、単票を使い、その都度用紙をセットされるのでしょうか。

との質問ですが、その通りです！というか、会社規定の外注で印刷された用紙や外部からの用紙があって、その上に元のデータから必要な部分を手書きしているので、これを印刷で効率を上げようと思ってます。勿論パターン毎に印刷するのである程度は一気にやれるとは思いますが・・・
もしかしてして！！一括印刷ボタンでもつくって、それで一気にってことですか？
実は、それも、ほしい機能です。１行ずつ表示させてから、最後まで確認して問題なければ、一括印刷させるようにもしたいと思っています。途中までいって問題なければ行数を ○行から○行まで印刷する という風にもしたいと思ってます。

この辺でも何かアドバイスがありましたらよろしくお願いします。

※それと、補足で質問ですが・・・
現在、sheet１のパターン番号を自動的に認識させようとしているのですが、その内容は、

例えば、Ａ列とＢ列にデータがある場合はＥ列に１を入力
Ｃ列とＤ列にデータがある場合はＥ列に２を入力
で、このパターンが５通りあります。

という風になるようなＶＢＡを一生懸命考えているのですが分かりません。

前回質問させていただいて以来、プログラムが動いたことに感動して、はじめてのＶＢＡプログラミングと言いう本を見ながら勉強しています。少しずつ分かってくるようにはなってきましたがまだまだです！早く出来るようになりたいと気ばかりが前へいって・・・でも実務は目の前だし・・・って感じで頑張ってます。
何卒宜しくお願いします。