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

最初に誤っておかないと・・・・ 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

解決したでしょうか。 確認ですが、各モジュールの先頭に「Option Explicit」はありますか？ 変数の宣言を強制するもので、ＶＢＥ画面で、ツール→オプション→編集タブの変数の宣言を強制する、にチェックを入れておくと自動的に出てきます。スペルミス等を発見するのに役立ちます。無ければ、各モジュールの先頭に書いてマクロを実行してみてください。何かわかるかも。。。 それから、カウンタに使っている(B5)セルの値はボタンを押すと＋１されますか？ また、状況がわかりませんので、作成されたHanteiとデータを数行、補足で示してもらえば何かわかるかもしれません。 ＞それと、（いろいろすみません） ・・・・もお願いします。贅沢言ってすみません！ そう面倒ないと思いますので次回に回答します。

＞上記のコードをデータシートのモジュールに書いていたんですが、操作する側のファイル（回答４を書いているファイル）に書かないといけないんですよね？？？ 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) ～ を書きます。 データシートには何も書きません。

＞問題は、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)繰り返し　　　の手順になるはずです。<　>は人の操作です。 テスト用に作ったシートを消してしまいました。想像だけで書いていますので不具合があれば教えてください。

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はあまり向いていないのかもしれませんね。 ・・・なんか、以前私が直面してきたことと同じ道を歩んでいらっしゃるようです(^^;)。がんばってください。私の所は、伝票印刷用のソフトを入れました。

＞Ａ・Ｂ・Ｃ）のように３つ列にデータがある場合がうまくいきません・・・ ３個の場合も同様と思って分けなかったんですが、 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まで何件も入力しておいてマクロを実行して一括セット（コピー） 他にも考えられますし補足して下さい。ア）、イ）は可能です。

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の回答は忘れてください(汗)。もっとよさそうなやり方を考え付きました。 複数の帳票を使うということですので、ワークシートを複数用意することにしましょう。 とりあえず、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:「印刷開始」ボタンをクリック。

＞この辺でも何かアドバイスがありましたらよろしくお願いします。 思いつくままに・・・・（よく同じようなことをしているもので） １．用紙換えが大変でしょうからデータを事前にパターンでソートしておいたらどうでしょう。 ２．ＶＢのテキストボックスで 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の回答はデータの入ったシートと印刷用のシートが共に開いていることを想定しています。 結局、どのようなコントロールを使用するかは問題ではなく、データをそれに見合ったシートに渡し、印刷時にセル色を制御する問題だったようです。 長くなりました。では。。。

私は同様のケースではＶＢのツールボックスのコントロールを使っています。 一回、テキストボックスの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