- 締切済み
VBAでスクロールバーを動かしても値が変わらない
図のようなスクロールバーを動かして、それぞれの値と、A4のセルの色が変わるものを作りたいのです。 プログラムは、 Sub スクロール1_Change() R = Range("C2").Value G = Range("D2").Value B = Range("E2").Value Range("A4").Interior.Color = RGB(R, G, B) End Sub Sub スクロール2_Change() R = Range("C2").Value G = Range("D2").Value B = Range("E2").Value Range("A4").Interior.Color = RGB(R, G, B) End Sub Sub スクロール3_Change() R = Range("C2").Value G = Range("D2").Value B = Range("E2").Value Range("A4").Interior.Color = RGB(R, G, B) End Sub ですが、スクロールバーに関連付けられていないようです。基本ですみませんが、関連付けるにはどうすればいいのでしょうか。
- JZ302
- お礼率92% (1106/1202)
- その他MS Office製品
- 回答数4
- ありがとう数4
- みんなの回答 （4）
- 専門家の回答
みんなの回答
- piroin654
- ベストアンサー率75% (692/917)
たとえば標準モジュールで、 ＞Sub スクロール1_Change() Sub cmdスクロール1_Change() ＞Sub スクロール2_Change() Sub cmdスクロール2_Change() ＞Sub スクロール3_Change() Sub cmdスクロール3_Change() のようにプロシージャ名を変更して、 Sheet1のコード表に Private Sub スクロール1_Change() Call cmdスクロール1_Change End Sub Private Sub スクロール2_Change() Call cmdスクロール2_Change End Sub Private Sub スクロール3_Change() Call cmdスクロール3_Change End Sub のようにしてスクロールバーのイベントを拾うこともできますが、 挙動が非常に悪いのであっさりNo3のようにしたほうがベスト だと思いますが。
- piroin654
- ベストアンサー率75% (692/917)
うっかり、見落としていましたが、こちらではSheet1に 質問の内容を設定し、したがってSeet1の コード表に設定していたので、No1のコードは実際には Private Sub スクロール1_Change() Range("A4").Interior.Color = RGB(255 - スクロール1.Value, 255 - スクロール2.Value, 255 - スクロール3.Value) Range("C2").Value = 255 - スクロール1.Value End Sub Private Sub スクロール2_Change() Range("A4").Interior.Color = RGB(255 - スクロール1.Value, 255 - スクロール2.Value, 255 - スクロール3.Value) Range("D2").Value = 255 - スクロール2.Value End Sub Private Sub スクロール3_Change() Range("A4").Interior.Color = RGB(255 - スクロール1.Value, 255 - スクロール2.Value, 255 - スクロール3.Value) Range("E2").Value = 255 - スクロール3.Value End Sub のように Private Sub で表記しています。したがて No1のSubでの表記ではありません。したがって、 そちらでスクロールバーを設定したSheetのコード表に 設定してみてください。こちらでは標準モジュールで 設定していないので・・・。 同時に、No2の設定もしてみてください。
お礼
ご回答ありがとうございました。標準モジュールでやりたいのですが。
- piroin654
- ベストアンサー率75% (692/917)
>各スクロールバーのMaxを255、Minを0にプロパティで設定 これは、Bookをマクロを無効で開いて、 スクロールバーの上で右クリックして、 表示されるメニューの中のプロパティ をクリックすればプロパティ表が 表示されます。そこに上記を 設定します。これを各スクロールバー について設定します。
お礼
ご回答ありがとうございました。
- piroin654
- ベストアンサー率75% (692/917)
RGBの各値は0から255まで変動しますから、 各スクロールバーのMaxを255、Minを0に プロパティで設定します。 それから、以下のように。 Sub スクロール1_Change() Range("A4").Interior.Color = RGB(255 - スクロール1.Value, 255 - スクロール2.Value, 255 - スクロール3.Value) Range("C2").Value = 255 - スクロール1.Value End Sub Sub スクロール2_Change() Range("A4").Interior.Color = RGB(255 - スクロール1.Value, 255 - スクロール2.Value, 255 - スクロール3.Value) Range("D2").Value = 255 - スクロール2.Value End Sub Sub スクロール3_Change() Range("A4").Interior.Color = RGB(255 - スクロール1.Value, 255 - スクロール2.Value, 255 - スクロール3.Value) Range("E2").Value = 255 - スクロール3.Value End Sub 基本的にはこのような感じです。
お礼
ご回答ありがとうございました。プロパティで設定する方法がわからないのですが。
関連するQ&A
- ＥＸＣＥＬ ＶＢＡで作成したスクロールバーの不具合を修正したいのですが
ちょっと言葉だと説明しにくいのですが、教えていただきたいことがあります。 ＥＸＣＥＬ ＶＢＡでスクロールバーを作成したのですが、 スクロールバーの上部1/5程度で全部のデータが終わってしまいます。 データ数に合わせて、スクロールした一番最後に最後のデータが来るように修正することは可能でしょうか。 自分で色々試してみましたが原因がさっぱりわかりませんでした。 作成したマクロは以下のとおりです。 ＊シート「一覧」のＡ列～Ｄ列×３０００行のデータを入力 シート「リスト」にスクロールバーを設置 Private Sub ScrollBar1_Change() currow = ScrollBar1.Value Call smpscrollbar End Sub Private Sub Workbook_Open() currow = 3 With Sheets("リスト").ScrollBar1 .Min = 3 .Max = Sheets("一覧").Range("A1").CurrentRegion.Rows.Count End With Call smpscrollbar End Sub Sub smpscrollbar() With Sheets("リスト") .Range("B1").Value = Sheets("一覧").Range("A" & currow).Value .Range("E1").Value = Sheets("一覧").Range("B" & currow).Value .Range("I1").Value = Sheets("一覧").Range("C" & currow).Value .Range("N1").Value = Sheets("一覧").Range("D" & currow).Value End With End Sub
- ベストアンサー
- オフィス系ソフト
- マクロでセルの色を塗りたい
マクロでセルの色を塗りたいです。 現在、予めRGBの値を取得しておいて Private Sub Worksheet_Change(ByVal Target As Range) Dim R As Integer Dim G As Integer Dim B As Integer R = 100 G = 50 B = 128 If Target.Value = "A" Then Target.Interior.Color = RGB(R, G, B) End If End Sub のように使っています。 このRGBの値を他の所で流用するに当たって、１つの変数のまとめたいのですが、 RGBをまとめて代入？する方法はあるでしょうか。 以下のような使い方をしたいです（勿論これはダメでしたけど。見るからにダメそうですし）。 Dim IRO As String IRO = "100, 50, 128" Target.Interior.Color = RGB(IRO) 不可能でしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡについて
http://okwave.jp/qa/q7236213.html 上記質問の発展形なのですが 同様のことを Ｅ列に日付 Ｆ列に売上 Ｇ列に結果 でやりたいのですが この時Ａ列～Ｃ列のマクロも残したままでしたいのですが 下記のように同様のプロシージャーを下段に書けばできると思ったのですが うまくいきません。 Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$A$1" Then Exit Sub If Target = "" Then Exit Sub Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With End Sub Private Sub worksheet_change(ByVal Target As Excel.Range) If Target.Address <> "$E$1" Then Exit Sub If Target = "" Then Exit Sub Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With End Sub どなたかお知恵を拝借できませんでしょうか？
- ベストアンサー
- オフィス系ソフト
- エクセルＶＢＡで最小値を求めたいのですが
下記はある表の最大値を求めるものですが 同様の条件で最小値を求めようと思い 「MAX」の箇所を「MIN」差し替えてできると思っていたのですが 最小値がのかわりに「0」が表示されてしまいます。 そのように修正すればよいでしょうか？ private sub worksheet_change(byval Target as excel.range) if target.cells(1) = "" then exit sub if target.address = "$A$1" then Range("C10:C65536").ClearContents With Range(Cells(9 + Range("A1").Value, "C"), Cells(Range("A65536").End(xlUp).Row, "C")) .FormulaR1C1 = "=MAX(RC2:R[" & -Range("A1").Value + 1 & "]C2,FALSE)" .Value = .Value End With elseif target.address = "$E$1" then Range("G10:G65536").ClearContents With Range(Cells(9 + Range("E1").Value, "G"), Cells(Range("E65536").End(xlUp).Row, "G")) .FormulaR1C1 = "=MAX(RC6:R[" & -Range("A1").Value + 1 & "]C6,FALSE)" .Value = .Value End With end if end sub
- ベストアンサー
- オフィス系ソフト
- VBAのセルの色の設定について
EXCEL・VBAにて.Interior.Color=RGB(152, 251, 152)と設定しましたが 思った色(緑系の色)ではなくグレー系の色になってしまったのですが、 何か間違っているのでしょうか？ 何かわかる方いらっしゃいますでしょうか？ 実際のソースはしたの通りとなります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 13 Then Exit Sub Application.EnableEvents = False 'ステータス欄の入力の判断 Select Case Target.Value Case "あああ" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(152, 251, 152) Case "いいい" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(254, 208, 224) Case "ううう" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(255, 255, 0) Case "えええ" Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(192, 192, 192) Case Else Worksheets("シート１").Rows(Target.Row).Interior.Color = RGB(255, 255, 255) End Select Application.EnableEvents = True End Sub
- ベストアンサー
- Visual Basic
- VBA のエラーがわかりません・・・ｗ
Sub Worksheet_Change(ByVal Target As Range) Dim 初期値 As Integer Dim 増減値 As Integer Select Case Target.Address Case "$C$5" Select Case Target.Value Case 1 Range("C6").Value = 24 Range("D5").Value = 600 Range("D6").Value = 0 Range("E5").Value = 400 Range("E6").Value = 0 Range("B7").Value = "★1 MaxAttackPoint:700 / MaxDeffencePoint:900" Case 2 Range("C6").Value = 32 Range("D5").Value = 1000 Range("D6").Value = 0 Range("E5").Value = 500 Range("E6").Value = 0 Range("B7").Value = "★2 MaxAttackPoint:1100 / MaxDeffencePoint:1300" End Select Case "$D$5" Select Case Range("C5").Value Case 1 初期値 = 600 Case 2 初期値 = 1000 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("D6").Value = (初期値 - Target.Value) / 100 * 増減値 Case "$E$5" Select Case Range("C5").Value Case 1 初期値 = 400 Case 2 初期値 = 500 Case Else Exit Sub End Select If Target.Value < 初期値 Then 増減値 = 4 Else 増減値 = 8 Range("E6").Value = (初期値 - Target.Value) / 200 * 増減値 End Select End Sub Sub Worksheet_Change(ByVal Target As Range) Select Case Target.Address Case "$F$5" Select Case Target.Value Case "炎" Range("F6").Value = 4 Case "水" Range("F6").Value = 4 End Select Case "$G$5" Select Case Target.Value Case "ドラゴン" Range("G6").Value = -8 Case "海竜" Range("G6").Value = -8 End Select Case "$H$5" Select Case Target.Value Case "ドラゴン" Range("H6").Value = -16 Case "海竜" Range("H6").Value = -16 End Select Case "$I$5" Select Case Target.Value Case "○" Range("I6").Value = 40 Case "×" Range("I6").Value = 0 End Select End Select End Sub とあるカードゲームのステータス決定を行う為に組まれたマクロです。 作成者は私だけではないのですが、もう何回もしつこく質問をしているため 気が引けてしまい、こちらで質問することにしました・・・ｗ エラー内容は ２つ目のSub Worksheet_Change(ByVal Target As Range)の 「Worksheet_Change」の名称が間違っています。 という事でした。何を入れればいいのかサッパリです(；´ω) エラーの改善方法について教えてください。 宜しくお願いします
- ベストアンサー
- オフィス系ソフト
- EXCEL 異なるVBA
教えて下さい、EXECL以下の異なるVBA (A>,B>)が２つあります、同じシートでそれぞれ動くようにさせたいです1つに合わせる事は出来ないでしょうか? 当方初心者の為わかりません教えて下さい。 A> Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address(0, 0, xlA1, 0) <> "A1" Then Exit Sub With Range("F9:I9,K17:K36").Borders(xlDiagonalUp) If Left$(Target.Value, 1) = "S" Then .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = xlAutomatic Else .LineStyle = xlNone End If End With End Sub B> Private Sub Worksheet_Change(ByVal Target As Range) With Sheet2 Select Case Target.Address Case Is = "$D$1" .Range("A1").Insert Shift:=xlDown .Range("A1").Value = Target.Value Case Is = "$D$2" .Range("B1").Insert Shift:=xlDown .Range("B1").Value = Target.Value End Select End With End Sub
- 締切済み
- その他([技術者向] コンピューター)
- エクセル VBA 検索 スクロール
お世話になります。 A列に製品名、B列に場所と詳細を表した表です。 E1に製品名を入れて検索ボタンを押すと右隣のセルの値がE1に表示され検索件数がMsgBoxに表示されるものをこのページで聞いたりしながら作りました。 'Dim 対象セル As Range 'Dim 最初のセル番地 As String 'Dim 検索件数 As Long Cells.Interior.ColorIndex = xlNone If Range("E1").Value = "" Then Exit Sub Set 対象セル = Range("A2:A1287").Find(What:=Range("E1").Value, After:=Range("A1287"), lookAt:=xlWhole) If 対象セル Is Nothing Then Exit Sub 最初のセル番地 = 対象セル.Address Do 対象セル.Interior.ColorIndex = 37 検索件数 = 検索件数 + 1 Set 対象セル = Range("A2:A1287").FindNext(対象セル) Loop While 対象セル.Address <> 最初のセル番地 Range("E3").Value = 対象セル.Offset(, 1).Value MsgBox "検索件数は" & 検索件数 & " 件です" End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub 今回質問したいのは検索したセルを含む行（製品名によって複数あります）を自動で一番上、A5でウィンドウの固定をしてあるのでA6からの表示になるようにスクロールするにはどのようにしたらいいでしょうか？よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBA 最終列に入力された値の表示について
VBAで最終列に入力された値の表示について教えてください。 例えば10行目の10列目(J列)に”123”と入力された値をセル”D1”に表示させたいのですがどのようにすればよいのでしょうか。 A列の最終行については Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long r = Cells(Rows.Count, 1).End(xlUp).Row Range("D1").Value = Cells(r, 1).Value End Sub でうまく表示できたのですが、最終列についてなかなかうまくいきません。 どなたかご指南ください宜しくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAのイベントについて教えてください。
エクセルVBA初学者のです。 "C9"にいれるとchangeイベントが発生するコードなんですが、 "C9"のほかに"D1"においてもchangeイベントを発生させたいのですが 下記のコードに続けて書いてもイベントが発生しないのですが どのように書けばよいのでしょうか？ private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("C9")) Is Nothing Then Exit Sub Range("H14:H56").Interior.ColorIndex = 2 If Intersect(Target, Range("D1")) Is Nothing Then Exit Sub Range("G14:G56").Interior.ColorIndex = 2 End Sub よろしくお願いします。
- ベストアンサー
- Visual Basic
お礼
ご回答ありがとうございました。 スクロールバー1本ずつ右クリックしてから、「プロパティ」を押して、Maxを255にし、LinkedCellを設定してから、「コードに表示」を押して、コードを書くことを、スクロール１からスクロール３まで丁寧に繰り返したらできました！ 私のプログラムで大丈夫でした。