Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11429 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【16065】別のシートの値をバー（図形）を動かす方法 さる 04/7/15(木) 17:27 質問[未読]
【16067】Re:別のシートの値をバー（図形）を動かす... IROC 04/7/15(木) 17:51 回答[未読]
【16068】Re:別のシートの値をバー（図形）を動かす... Asaki 04/7/15(木) 17:52 回答[未読]
【16110】Re:別のシートの値をバー（図形）を動かす... さる 04/7/16(金) 18:38 質問[未読]
【16112】Re:別のシートの値をバー（図形）を動かす... IROC 04/7/16(金) 18:45 回答[未読]
【16115】Re:別のシートの値をバー（図形）を動かす... さる 04/7/16(金) 19:36 発言[未読]
【16117】Re:別のシートの値をバー（図形）を動かす... IROC 04/7/16(金) 22:00 回答[未読]
【16120】Re:別のシートの値をバー（図形）を動か... さる 04/7/17(土) 0:30 質問[未読]
【16121】Re:別のシートの値をバー（図形）を動か... IROC 04/7/17(土) 0:37 回答[未読]
【16125】Re:別のシートの値をバー（図形）を動か... さる 04/7/17(土) 1:13 質問[未読]
【16126】Re:別のシートの値をバー（図形）を動か... IROC 04/7/17(土) 1:23 回答[未読]
【16127】Re:別のシートの値をバー（図形）を動か... さる 04/7/17(土) 1:27 質問[未読]
【16140】Re:別のシートの値をバー（図形）を動か... さる 04/7/17(土) 15:04 お礼[未読]
【16146】Re:別のシートの値をバー（図形）を動か... IROC 04/7/17(土) 16:10 回答[未読]
【16148】Re:別のシートの値をバー（図形）を動か... さる 04/7/17(土) 17:20 質問[未読]
【16149】Re:別のシートの値をバー（図形）を動か... IROC 04/7/17(土) 17:33 回答[未読]
【16151】Re:別のシートの値をバー（図形）を動か... さる 04/7/17(土) 20:05 質問[未読]
【16152】Re:別のシートの値をバー（図形）を動か... IROC 04/7/17(土) 20:20 回答[未読]
【16065】別のシートの値をバー（図形）を動かす方...
質問  さる E-MAIL  - 04/7/15(木) 17:27 -
引用なし
パスワード
   わかりにくいと思うが説明します。
シート１
　23
シート２
　A5:C5のセルにバー（図形）を動かす。
もし分かりにくい場合は圧縮メールを送りますので見てはわかる
と思います。
私はVBA初心者ですので皆さんの協力お願いします。
【16067】Re:別のシートの値をバー（図形）を動か...
回答  IROC  - 04/7/15(木) 17:51 -
引用なし
パスワード
   「マクロの記録」を利用しては如何でしょうか？
【16068】Re:別のシートの値をバー（図形）を動か...
回答  Asaki  - 04/7/15(木) 17:52 -
引用なし
パスワード
   こんにちは。

分かりにくいです。

>シート１
>　23
これは何でしょう？

取り敢えず、マクロの記録は参考になりませんか？
【16110】Re:別のシートの値をバー（図形）を動か...
質問  さる E-MAIL  - 04/7/16(金) 18:38 -
引用なし
パスワード
   図形を使って投稿できないから説明できなくてすみません。
作ったExcelを圧縮してメールを送りたいが、
見て分かるように説明してあります。私のメルアドはsato-ru@h2.dion.ne.jpです。返事きたらすぐメール折り返しします。
説明
シート１（ポイント変換）
NO.１　25点
NO.２　22点
NO.３　11点
シート2（ポイント判定）
図形（□）バーを高低コントロールします。点が低くなるとバーがセル2へ図形
バーを移動する。高くなるとセル25へ移動する。

シート１のポイントを読み取ってシート２の図形（□）バーをコントロールする形です。
どうか本の参考など載せていませんので分からない状態です。
わらをつかむ気持ちなんですがどうか指導お願いします。
　　　
【16112】Re:別のシートの値をバー（図形）を動か...
回答  IROC  - 04/7/16(金) 18:45 -
引用なし
パスワード
   こちらの質問にも答えて頂きたいです。

マクロの記録は試されましたか？
【16115】Re:別のシートの値をバー（図形）を動か...
発言  さる E-MAIL  - 04/7/16(金) 19:36 -
引用なし
パスワード
   ▼IROC さん：
>こちらの質問にも答えて頂きたいです。
>
>マクロの記録は試されましたか？
試してみましたが
意味が分からないコードです。
Sub Macro1()
'
' Macro1 Macro
' マクロ記録日 : 2004/7/16　ユーザー名 : さとる
'

'
　　Range("AW2").Select
　　Sheets("ストレス判定").Select
　　ActiveWindow.SmallScroll Down:=-6
　　ActiveSheet.Shapes("Rectangle 44").Select
　　Selection.ShapeRange.IncrementLeft 6#
　　Selection.ShapeRange.IncrementTop -0.75
End Sub
【16117】Re:別のシートの値をバー（図形）を動か...
回答  IROC  - 04/7/16(金) 22:00 -
引用なし
パスワード
   Private Sub Worksheet_Change(ByVal Target As Range)
Dim myPoint As String
Dim ws As Worksheet, ws_d As Worksheet
Dim r As Range 'FIND用
Dim i As Long
　　
　　Set ws_d = Worksheets("data")
　　Set ws = Worksheets("ストレス判定")
　　
　　If Target.Address = Range("AW2").Address Then
　　　　
　　　　myPoint = Target.Value 'ポイント
　　　　　　
　　　　'ポイントをもとに、dataシートのリストを検索
　　　　Set r = ws_d.Range("B2:Y2").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole)
　　　　
　　　　'リストに見つからないとき
　　　　If r Is Nothing Then
　　　　　　MsgBox "無効な値です"
　　　　　　Exit Sub
　　　　End If
　　　　
　　　　i = r.Offset(1).Value '図形位置
　　　　
　　　　ws.Shapes("仕事").Top = ws.Range("AV5").Top
　　　　'セル値に応じて横方向にオフセット
　　　　ws.Shapes("仕事").Left = ws.Range("AV5").Offset(0, i - 1).Left
　　　　　　　　　　　　
　　End If
　　
End Sub
【16120】Re:別のシートの値をバー（図形）を動か...
質問  さる E-MAIL  - 04/7/17(土) 0:30 -
引用なし
パスワード
   ありがとうございます。参考になりました。
でも、他の判定も入れておきましたがエラーになった。
IFエラーだって。どこが悪いですか？

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myPoint As String
Dim ws As Worksheet, ws_d As Worksheet
Dim r As Range 'FIND用
Dim i As Long
　　
　　Set ws_d = Worksheets("data")
　　Set ws = Worksheets("ストレス判定")
　　
　　If Target.Address = Range("AW2").Address Then
　　 If Target.Address = Range("AX2").Address Then
　　 If Target.Address = Range("Ay2").Address Then
　　 If Target.Address = Range("Az2").Address Then
　　 If Target.Address = Range("BA2").Address Then
　　　　myPoint = Target.Value 'ポイント
　　　　　　
　　　　'ポイントをもとに、dataシートのリストを検索
　　　　Set r = ws_d.Range("B2:BA2").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '仕事
　　　　Set r = ws_d.Range("B6:AR6").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '精神的
　　　　Set r = ws_d.Range("B10:AF10").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '身体的
　　　　Set r = ws_d.Range("B14:K14").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '疲労
　　　　Set r = ws_d.Range("B18:T18").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '抑うつ
　　　　'リストに見つからないとき
　　　　If r Is Nothing Then
　　　　　　MsgBox "無効な値です"
　　　　　　Exit Sub
　　　　End If
　　　　
　　　　i = r.Offset(1).Value '図形位置
　　　　
　　　　ws.Shapes("仕事").Top = ws.Range("AV5").Top
　　　　ws.Shapes("精神").Top = ws.Range("D25").Top
　　　　ws.Shapes("身体").Top = ws.Range("AV25").Top
　　　　ws.Shapes("疲労").Top = ws.Range("D43").Top
　　　　ws.Shapes("抑うつ").Top = ws.Range("AV43").Top
　　　　
　　　　'セル値に応じて横方向にオフセット
　　　　ws.Shapes("仕事").Left = ws.Range("AV5").Offset(0, i - 1).Left
　　　　ws.Shapes("精神").Left = ws.Range("D25").Offset(0, i - 1).Left
　　　　ws.Shapes("身体").Left = ws.Range("AV25").Offset(0, i - 1).Left
　　　　ws.Shapes("疲労").Left = ws.Range("D43").Offset(0, i - 1).Left
　　　　ws.Shapes("抑うつ").Left = ws.Range("AV43").Offset(0, i - 1).Left
　　　　
　　End If
　　
End Sub
【16121】Re:別のシートの値をバー（図形）を動か...
回答  IROC  - 04/7/17(土) 0:37 -
引用なし
パスワード
   if文のミスです。

ヘルプを読んで構文を確認して下さい。
【16125】Re:別のシートの値をバー（図形）を動か...
質問  さる E-MAIL  - 04/7/17(土) 1:13 -
引用なし
パスワード
   IROC　様
IF文を直したけどコンパイルエラーを出るけど
どこか悪いですか？
私はVBA初心者なのでご指導お願いします。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myPoint As String
Dim ws As Worksheet, ws_d As Worksheet
Dim r As Range 'FIND用
Dim i As Long
　　
　　Set ws_d = Worksheets("data")
　　Set ws = Worksheets("ストレス判定")
　　
　　If Target.Address = Range("AW2").Address Then
　
　　　　myPoint = Target.Value 'ポイント
　　　　　　
　　　　'ポイントをもとに、dataシートのリストを検索
　　　　Set r = ws_d.Range("B2:BA2").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '仕事
　　　
　　　　'リストに見つからないとき
　　　If r Is Nothing Then
　　　　　　MsgBox "無効な値です"
　　　　　　Exit Sub
　　　　End If
　　　　
　　　　i = r.Offset(1).Value '図形位置
　　　　
　　　　ws.Shapes("仕事").Top = ws.Range("AV5").Top
　　　　
　　　　'セル値に応じて横方向にオフセット
　　　　ws.Shapes("仕事").Left = ws.Range("AV5").Offset(0, i - 1).Left
　　　　
　　End If
　　
　　 If Target.Address = Range("AX2").Address Then
　　 myPoint = Target.Value 'ポイント
　　 'ポイントをもとに、dataシートのリストを検索
　　 Set r = ws_d.Range("B6:AR6").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '精神的
　　 'リストに見つからないとき
　　　If r Is Nothing Then
　　　　　　MsgBox "無効な値です"
　　　　　　Exit Sub
　　　　End If
　　 i = r.Offset(1).Value '図形位置
　　　ws.Shapes("精神").Top = ws.Range("D25").Top
　　 'セル値に応じて横方向にオフセット
　　 ws.Shapes("精神").Left = ws.Range("D25").Offset(0, i - 1).Left
　　 End If
　　
　　If Target.Address = Range("Ay2").Address Then
　　myPoint = Target.Value 'ポイント
　　'ポイントをもとに、dataシートのリストを検索
　　Set r = ws_d.Range("B10:AF10").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '身体的
　　'リストに見つからないとき
　　　If r Is Nothing Then
　　　　　　MsgBox "無効な値です"
　　　　　　Exit Sub
　　　　End If
　　 i = r.Offset(1).Value '図形位置
　　　ws.Shapes("身体").Top = ws.Range("AV25").Top
　　 'セル値に応じて横方向にオフセット
　　 ws.Shapes("身体").Left = ws.Range("AV25").Offset(0, i - 1).Left
　　 End If
　　
　　If Target.Address = Range("Az2").Address Then
　　myPoint = Target.Value 'ポイント
　　'ポイントをもとに、dataシートのリストを検索
　　 Set r = ws_d.Range("B14:K14").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '疲労
　　 'リストに見つからないとき
　　　If r Is Nothing Then
　　　　　　MsgBox "無効な値です"
　　　　　　Exit Sub
　　　　End If
　　 i = r.Offset(1).Value '図形位置
　　 ws.Shapes("疲労").Top = ws.Range("D43").Top
　　 'セル値に応じて横方向にオフセット
　　 ws.Shapes("疲労").Left = ws.Range("D43").Offset(0, i - 1).Left
　　 End If
　　
　　If Target.Address = Range("BA2").Address Then
　　 myPoint = Target.Value 'ポイント
　　'ポイントをもとに、dataシートのリストを検索
　　　 Set r = ws_d.Range("B18:T18").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '抑うつ
　　　'リストに見つからないとき
　　　If r Is Nothing Then
　　　　　　MsgBox "無効な値です"
　　　　　　Exit Sub
　　　　End If
　　 i = r.Offset(1).Value '図形位置
　　 ws.Shapes("抑うつ").Top = ws.Range("AV43").Top
　　　　'セル値に応じて横方向にオフセット
　　　　ws.Shapes("抑うつ").Left = ws.Range("AV43").Offset(0, i - 1).Left
　　　 End If
End Sub
【16126】Re:別のシートの値をバー（図形）を動か...
回答  IROC  - 04/7/17(土) 1:23 -
引用なし
パスワード
   >IF文を直したけどコンパイルエラーを出るけどどこか悪いですか？

私の環境ではコンパイルエラーにならないですよ・・？
【16127】Re:別のシートの値をバー（図形）を動か...
質問  さる E-MAIL  - 04/7/17(土) 1:27 -
引用なし
パスワード
   IROC　様
間違えて申し訳はありません。
>IF文を直したけどコンパインじゃなくてデバックを出るけど
>どこか悪いですか？
>私はVBA初心者なのでご指導お願いします。
>
>Private Sub Worksheet_Change(ByVal Target As Range)
>Dim myPoint As String
>Dim ws As Worksheet, ws_d As Worksheet
>Dim r As Range 'FIND用
>Dim i As Long
>　　
>　　Set ws_d = Worksheets("data")
>　　Set ws = Worksheets("ストレス判定")
>　　
>　　If Target.Address = Range("AW2").Address Then
>　
>　　　　myPoint = Target.Value 'ポイント
>　　　　　　
>　　　　'ポイントをもとに、dataシートのリストを検索
>　　　　Set r = ws_d.Range("B2:BA2").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '仕事
>　　　
>　　　　'リストに見つからないとき
>　　　If r Is Nothing Then
>　　　　　　MsgBox "無効な値です"
>　　　　　　Exit Sub
>　　　　End If
>　　　　
>　　　　i = r.Offset(1).Value '図形位置
>　　　　
>　　　　ws.Shapes("仕事").Top = ws.Range("AV5").Top
>　　　　
>　　　　'セル値に応じて横方向にオフセット
>　　　　ws.Shapes("仕事").Left = ws.Range("AV5").Offset(0, i - 1).Left
>　　　　
>　　End If
>　　
>　　 If Target.Address = Range("AX2").Address Then
>　　 myPoint = Target.Value 'ポイント
>　　 'ポイントをもとに、dataシートのリストを検索
>　　 Set r = ws_d.Range("B6:AR6").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '精神的
>　　 'リストに見つからないとき
>　　　If r Is Nothing Then
>　　　　　　MsgBox "無効な値です"
>　　　　　　Exit Sub
>　　　　End If
>　　 i = r.Offset(1).Value '図形位置
>　　　ws.Shapes("精神").Top = ws.Range("D25").Top
>　　 'セル値に応じて横方向にオフセット
>　　 ws.Shapes("精神").Left = ws.Range("D25").Offset(0, i - 1).Left
>　　 End If
>　　
>　　If Target.Address = Range("Ay2").Address Then
>　　myPoint = Target.Value 'ポイント
>　　'ポイントをもとに、dataシートのリストを検索
>　　Set r = ws_d.Range("B10:AF10").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '身体的
>　　'リストに見つからないとき
>　　　If r Is Nothing Then
>　　　　　　MsgBox "無効な値です"
>　　　　　　Exit Sub
>　　　　End If
>　　 i = r.Offset(1).Value '図形位置
>　　　ws.Shapes("身体").Top = ws.Range("AV25").Top
>　　 'セル値に応じて横方向にオフセット
>　　 ws.Shapes("身体").Left = ws.Range("AV25").Offset(0, i - 1).Left
>　　 End If
>　　
>　　If Target.Address = Range("Az2").Address Then
>　　myPoint = Target.Value 'ポイント
>　　'ポイントをもとに、dataシートのリストを検索
>　　 Set r = ws_d.Range("B14:K14").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '疲労
>　　 'リストに見つからないとき
>　　　If r Is Nothing Then
>　　　　　　MsgBox "無効な値です"
>　　　　　　Exit Sub
>　　　　End If
>　　 i = r.Offset(1).Value '図形位置
>　　 ws.Shapes("疲労").Top = ws.Range("D43").Top
>　　 'セル値に応じて横方向にオフセット
>　　 ws.Shapes("疲労").Left = ws.Range("D43").Offset(0, i - 1).Left
>　　 End If
>　　
>　　If Target.Address = Range("BA2").Address Then
>　　 myPoint = Target.Value 'ポイント
>　　'ポイントをもとに、dataシートのリストを検索
>　　　 Set r = ws_d.Range("B18:T18").Find(myPoint, LookIn:=xlValues, LookAt:=xlWhole) '抑うつ
>　　　'リストに見つからないとき
>　　　If r Is Nothing Then
>　　　　　　MsgBox "無効な値です"
>　　　　　　Exit Sub
>　　　　End If
>　　 i = r.Offset(1).Value '図形位置
>　　 ws.Shapes("抑うつ").Top = ws.Range("AV43").Top
>　　　　'セル値に応じて横方向にオフセット
>　　　　ws.Shapes("抑うつ").Left = ws.Range("AV43").Offset(0, i - 1).Left
>　　　 End If
>End Sub
【16140】Re:別のシートの値をバー（図形）を動か...
お礼  さる E-MAIL  - 04/7/17(土) 15:04 -
引用なし
パスワード
   IROC　様
ありがとうございました。私のミスでした。作動できました。
これから差込印刷のVBAを取り組んでしましたがエラーになるけど
どこか悪いでしょうか？

Sub 一人ずつ印刷_click()


Dim PrintMenu As Long
Dim i As Long

With Worksheets("全体データ")

　　For i = 3 To .Range("A65536").End(xlUp).Row
　　　　Worksheets("プロフィール").Range("CE45").Value = .Cells(i, 1).Value '整理番号
　　　　Worksheets("プロフィール").Range("AG35").Value = .Cells(i, 2).Value '氏名
　　　　Worksheets("プロフィール").Range("AG34").Value = .Cells(i, 3).Value '社員番号
　　　　Worksheets("プロフィール").Range("CO52").Value = .Cells(i, 7).Value '判定結果A-1
　　　　Worksheets("プロフィール").Range("CO53").Value = .Cells(i, 9).Value '判定結果A-2
　　　　Worksheets("プロフィール").Range("CO54").Value = .Cells(i, 11).Value '判定結果A-3
　　　　Worksheets("プロフィール").Range("CO55").Value = .Cells(i, 13).Value '判定結果A-4
　　　　Worksheets("プロフィール").Range("CO56").Value = .Cells(i, 15).Value '判定結果A-5
　　　　Worksheets("プロフィール").Range("CO57").Value = .Cells(i, 17).Value '判定結果A-6
　　　　Worksheets("プロフィール").Range("CO58").Value = .Cells(i, 19).Value '判定結果A-7
　　　　Worksheets("プロフィール").Range("CO59").Value = .Cells(i, 21).Value '判定結果A-8
　　　　Worksheets("プロフィール").Range("CO60").Value = .Cells(i, 23).Value '判定結果A-9
　　　　Worksheets("プロフィール").Range("CO62").Value = .Cells(i, 25).Value '判定結果B-1
　　　　Worksheets("プロフィール").Range("CO63").Value = .Cells(i, 27).Value '判定結果B-2
　　　　Worksheets("プロフィール").Range("CO64").Value = .Cells(i, 29).Value '判定結果B-3
　　　　Worksheets("プロフィール").Range("CO65").Value = .Cells(i, 31).Value '判定結果B-4
　　　　Worksheets("プロフィール").Range("CO66").Value = .Cells(i, 33).Value '判定結果B-5
　　　　Worksheets("プロフィール").Range("CO67").Value = .Cells(i, 35).Value '判定結果B-6
　　　　Worksheets("プロフィール").Range("CO69").Value = .Cells(i, 37).Value '判定結果C-1
　　　　Worksheets("プロフィール").Range("CO70").Value = .Cells(i, 39).Value '判定結果C-2
　　　　Worksheets("プロフィール").Range("CO71").Value = .Cells(i, 41).Value '判定結果C-3
　　　　Worksheets("プロフィール").Range("CO72").Value = .Cells(i, 43).Value '判定結果C-4

With Worksheets("ストレスポイント変換")

　　
　　　　Worksheets("プロフィール").Range("N141").Value = .Cells(i, 49).Value '仕事
　　　　Worksheets("プロフィール").Range("N142").Value = .Cells(i, 50).Value '仕事
　　　　Worksheets("プロフィール").Range("N143").Value = .Cells(i, 51).Value '仕事
　　　　Worksheets("プロフィール").Range("N144").Value = .Cells(i, 52).Value '仕事
　　　　Worksheets("プロフィール").Range("N145").Value = .Cells(i, 53).Value '仕事
　　　　Worksheets("プロフィール").Select

PrtMsg:
　PrintMenu = MsgBox("印刷を実行してもいいですか？。　もし中止したい場合はEscキーを数回に押して下さい" & Chr(13) & _
　　　　　　　　　"　[は　い]　　　:　印刷実行" & Chr(13) & _
　　　　　　　　　"　[いいえ]　　　:　印刷プレビュー" & Chr(13) & _
　　　　　　　　　"　[キャンセル]　:　次を読込", 3, "確認")
　　　
　　　　　　　　　　If PrintMenu = 6 Then 'はい（印刷実行）
　　　　　　 MsgBox "印刷します。"
　　　　　　 Worksheets("結果表").PrintOut
　　　　

　　　　ElseIf PrintMenu = 7 Then 'いいえ（印刷プレビュー）
　　　　　　 Worksheets("結果表").PrintPreview
　　　　　　 GoTo PrtMsg　'プレビューを閉じた後、確認メッセージに戻る。
　　　　
　　　　ElseIf PrintMenu = 2 Then 'キャンセル（何もしない）
　　　　　　
　　　　End If
　　　
　　Next i
　　
End With
End Sub
【16146】Re:別のシートの値をバー（図形）を動か...
回答  IROC  - 04/7/17(土) 16:10 -
引用なし
パスワード
   どこで、どのようなエラーになるのか書いて頂かないと判断できません。
【16148】Re:別のシートの値をバー（図形）を動か...
質問  さる E-MAIL  - 04/7/17(土) 17:20 -
引用なし
パスワード
   申し訳はありません。
エラーは
コンパインエラー
nextに対応するForがありませんと表示してありますが
どこのエラーを見つからないので
どうかお願いします。
【16149】Re:別のシートの値をバー（図形）を動か...
回答  IROC  - 04/7/17(土) 17:33 -
引用なし
パスワード
   With文の使い方が間違っています。
【16151】Re:別のシートの値をバー（図形）を動か...
質問  さる E-MAIL  - 04/7/17(土) 20:05 -
引用なし
パスワード
   ▼IROC さん：
>With文の使い方が間違っています。
ありがとうございます。直してみたらエラーなかったけど
何の表示が出ない。
どこかおかしいでしょうか？


Sub 一人ずつ印刷_click()


Dim PrintMenu As Long
Dim i As Long

With Worksheets("全体データ")

　　For i = 3 To .Range("A65536").End(xlUp).Row
　　　　Worksheets("プロフィール").Range("CE45").Value = .Cells(i, 1).Value '整理番号
　　　　Worksheets("プロフィール").Range("AG35").Value = .Cells(i, 2).Value '氏名
　　　　Worksheets("プロフィール").Range("AG34").Value = .Cells(i, 3).Value '社員番号
　　　　Worksheets("プロフィール").Range("CO52").Value = .Cells(i, 7).Value '判定結果A-1
　　　　Worksheets("プロフィール").Range("CO53").Value = .Cells(i, 9).Value '判定結果A-2
　　　　Worksheets("プロフィール").Range("CO54").Value = .Cells(i, 11).Value '判定結果A-3
　　　　Worksheets("プロフィール").Range("CO55").Value = .Cells(i, 13).Value '判定結果A-4
　　　　Worksheets("プロフィール").Range("CO56").Value = .Cells(i, 15).Value '判定結果A-5
　　　　Worksheets("プロフィール").Range("CO57").Value = .Cells(i, 17).Value '判定結果A-6
　　　　Worksheets("プロフィール").Range("CO58").Value = .Cells(i, 19).Value '判定結果A-7
　　　　Worksheets("プロフィール").Range("CO59").Value = .Cells(i, 21).Value '判定結果A-8
　　　　Worksheets("プロフィール").Range("CO60").Value = .Cells(i, 23).Value '判定結果A-9
　　　　Worksheets("プロフィール").Range("CO62").Value = .Cells(i, 25).Value '判定結果B-1
　　　　Worksheets("プロフィール").Range("CO63").Value = .Cells(i, 27).Value '判定結果B-2
　　　　Worksheets("プロフィール").Range("CO64").Value = .Cells(i, 29).Value '判定結果B-3
　　　　Worksheets("プロフィール").Range("CO65").Value = .Cells(i, 31).Value '判定結果B-4
　　　　Worksheets("プロフィール").Range("CO66").Value = .Cells(i, 33).Value '判定結果B-5
　　　　Worksheets("プロフィール").Range("CO67").Value = .Cells(i, 35).Value '判定結果B-6
　　　　Worksheets("プロフィール").Range("CO69").Value = .Cells(i, 37).Value '判定結果C-1
　　　　Worksheets("プロフィール").Range("CO70").Value = .Cells(i, 39).Value '判定結果C-2
　　　　Worksheets("プロフィール").Range("CO71").Value = .Cells(i, 41).Value '判定結果C-3
　　　　Worksheets("プロフィール").Range("CO72").Value = .Cells(i, 43).Value '判定結果C-4
　　Next i
End With
With Worksheets("ストレスポイント変換")
　　For i = 3 To .Range("A65536").End(xlUp).Row
　　
　　　　Worksheets("プロフィール").Range("N141").Value = .Cells(i, 49).Value '仕事
　　　　Worksheets("プロフィール").Range("N142").Value = .Cells(i, 50).Value '仕事
　　　　Worksheets("プロフィール").Range("N143").Value = .Cells(i, 51).Value '仕事
　　　　Worksheets("プロフィール").Range("N144").Value = .Cells(i, 52).Value '仕事
　　　　Worksheets("プロフィール").Range("N145").Value = .Cells(i, 53).Value '仕事
　　　　Worksheets("結果表").Select

PrtMsg:
　PrintMenu = MsgBox("印刷を実行してもいいですか？。　もし中止したい場合はEscキーを数回に押して下さい" & Chr(13) & _
　　　　　　　　　"　[は　い]　　　:　印刷実行" & Chr(13) & _
　　　　　　　　　"　[いいえ]　　　:　印刷プレビュー" & Chr(13) & _
　　　　　　　　　"　[キャンセル]　:　次を読込", 3, "確認")
　　　
　　　　　　　　　　If PrintMenu = 6 Then 'はい（印刷実行）
　　　　　　 MsgBox "印刷します。"
　　　　　　 Worksheets("結果表").PrintOut
　　　　

　　　　ElseIf PrintMenu = 7 Then 'いいえ（印刷プレビュー）
　　　　　　 Worksheets("結果表").PrintPreview
　　　　　　 GoTo PrtMsg　'プレビューを閉じた後、確認メッセージに戻る。
　　　　
　　　　ElseIf PrintMenu = 2 Then 'キャンセル（何もしない）
　　　　　　
　　　　End If
　　　
　 Next i
　　
End With
End Sub
【16152】Re:別のシートの値をバー（図形）を動か...
回答  IROC  - 04/7/17(土) 20:20 -
引用なし
パスワード
   F8キーでステップ実行して、
ローカルウィンドウで変数を確認しながら
落ち着いて調べてみて下さい。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11429 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free