VBAでオプションボタンを透過

このQ&Aのポイント
  • VBAを使用してワークシート上にOLEオブジェクトのオプションボタンを設置しましたが、透過機能が正常に機能しない問題が発生しています。
  • マクロ内で透過設定を行っていますが、設定内容に問題がある可能性があります。
  • 正しい透過設定を行うためには、他の方法を検討する必要があります。
回答を見る
  • ベストアンサー

VBAでオプションボタンを透過

ワークシート上にOLEオブジェクトのオプションボタンを設置するため、以下のようなマクロを書きました。 意図したように作動するのですが、一箇所だけ不具合があります。 .Object.BackStyle = fmBackStyleTransparent と、透過に設定してるのですが透過してくれません。(エラーにもなりません。) どこがおかしいのでしょうか? Sub test02() Dim n As Long, i As Long Dim myRng As Range With ActiveSheet For n = 3 To 5 For i = 3 To 10 Set myRng = .Cells(i, n) Set opt = .OLEObjects.Add(ClassType:="Forms.OptionButton.1", _ Left:=myRng.Left + 2, Top:=myRng.Top + 2, Width:=myRng.Width * 0.8, Height:=myRng.Height * 0.9) opt.LinkedCell = myRng.Offset(, 4).Address opt.Object.Value = False opt.Object.GroupName = "OptG" & i opt.Object.Caption = Choose(n - 2, "Yes", "No", "N/A") opt.Object.BackStyle = fmBackStyleTransparent Next i Next n End With End Sub

質問者が選んだベストアンサー

  • ベストアンサー
回答No.1

Next i の前の行あたりに、以下を挿入すると取りあえずできます。 opt.Interior.Pattern = xlNone 上記で取りあえずと書いたのは、Excel2003だと、フォーカスのあるコントロール は透過はされないようですが、フォーカスが別のコントロールに移っても透過 されないままの場合があるようです。透過してくれる場合もあって、その法則性 はよくわからないです。 Excel2010では、透過されないのは現在フォーカスのあるコントロールのみだけ で、他のコントロールはちゃんと透過してくれています。 以上

emaxemax
質問者

お礼

早速ありがとうございます。 opt.Interior.Pattern = xlNone 試しました。 ちゃんと透過したオプションボタンが現われました。 でもおっしゃるとおり、クリックすると透過されませんし、一旦そうなると別のボタンをクリックしても透過されないままですね。(何度かいじるとまた透過されたりする・・・) 何か変な動きですね。

emaxemax
質問者

補足

今日、エクセル2007にさわる機会があったので試しました。 2003と同じ結果でした。 2010じゃなきゃだめなんですね。 これはエクセルのバグなんでしょうか。

その他の回答 (1)

  • merlionXX
  • ベストアンサー率48% (1930/4007)
回答No.2

わたし(エクセル2000使用)はOLEオブジェクトはあまりつかわないので、旧来のフォームのオプションボタンを使ってやってみました。 フォームのオプションボタンとOLEのそれの違いは当然ご存知とは思いますが、一番の違いのグループボックスを非表示にすることでだいぶ近いものにしました。 ただ、リンク先の表示がOLEの場合と違って数字になるのはどうしようもないです。 また、サイズに制約があるので勝手に行高も変えてしまいました。 こんな感じですが、新しいシートでお確かめ下さい。 Sub test03() 'Formの場合   Dim n As Long, i As Long   Dim Rng As Range   Dim gb As GroupBox, opt As OptionButton   With ActiveSheet     .Cells.RowHeight = 19.5 '行高を19.5に設定     For i = 3 To 10 '先にグループボックス挿入       Set Rng = .Range(.Cells(i, "C"), .Cells(i, "E"))       Set gb = .GroupBoxes.Add(Left:=Rng.Left, _       Top:=Rng.Top, Width:=Rng.Width, Height:=Rng.Height)       gb.Characters.Text = ""       gb.Visible = False '非表示に       For n = 3 To 5 'オプションボタン挿入         Set Rng = .Cells(i, n)         Set opt = .OptionButtons.Add(Left:=Rng.Left + 2, _         Top:=Rng.Top + 2, Width:=Rng.Width * 0.8, Height:=Rng.Height * 0.9)         opt.LinkedCell = .Cells(Rng.Row, "G").Address         opt.Value = xlOff         opt.Characters.Text = Choose(n - 2, "Yes", "No", "N/A")         opt.ShapeRange.Fill.Visible = msoFalse '透明に         opt.ShapeRange.Line.Visible = msoFalse '線無しに       Next n     Next i     Set Rng = Nothing     Set gb = Nothing     Set opt = Nothing   End With End Sub

emaxemax
質問者

お礼

有難うございます。 フォームのオプションボタンなら簡単に透過させられることは知っていました。 ただ、グループボックスが見えるのがいまいちで、ボタンがグループボックスをはみ出したりするととんでもない結果を招くので二の足を踏んでいました。 なるほど、このように非表示にする手があったのですね! 勉強になりました。

関連するQ&A

  • VBAでオプションボタンの設定

    ワークシート上にOLEオブジェクトのオプションボタンを配置して、LinkedCellを設定し、同一行でGroupName を設定し、Caption をYesとNoにしようと思いました。 ところが、以下のコードですと、GroupName とCaption がエラーになってしまいます。 どのように直せばいいのでしょうか? エクセル2003です。 Sub test01() Dim n As Long, i As Long With ActiveSheet For n = 1 To 2 For i = 1 To 3 Set opt = .OLEObjects.Add(ClassType:="Forms.OptionButton.1", _ Left:=.Cells(i, n).Left, Top:=.Cells(i, n).Top, Width:=50, Height:=18) opt.LinkedCell = .Cells(i, n).Offset(, 4).Address ' opt.GroupName = "OptG" & i ' opt.Caption = IIf(n = 1, "Yes", "No") Next i Next n End With End Sub

  • (VBA)スピンボタンの大量コピー(相対参照)

    お世話になります。質問させていただきます。 表題件ですが、EXCELにて 「A列にコントロールツールの"スピンボタン"をリンクセルを相対参照にして縦に大量にコピー(さらに増減値をデフォルトの1から10に変更)」したいと考えています。 以下に記載したVBAコードは、こちらと同様のQ&Aサイトにて見つけてきた「A列にコントロールツールの"チェックボックス"をリンクセルを相対参照にして縦に大量にコピー」するコードです。 先ずは参考までにご確認ください。 ----------------------------------------------------------------- Sub Checkbox連続作成() Dim myChk As Object Dim i As Long Dim Sakuseisuu As Long Dim StartCell As Range '--------↓ここを変更--------- Sakuseisuu = 20 'チェックボックスの作成数 Set StartCell = Range("A1") 'スタートする位置 '--------↑ここを変更--------- For i = 0 To Sakuseisuu - 1 With StartCell.Offset(i) Set myChk = ActiveSheet _ .OLEObjects.Add(classtype:="Forms.CheckBox.1", _ Link:=False, DisplayAsIcon:=False, _ Left:=.Left, Top:=.Top, _ Width:=.Width, Height:=.Height) End With With myChk .LinkedCell = StartCell.Offset(i, 1).Address .Object.Caption = "" .Object.Value = False End With Next End Sub ------------------------------------------------------------------ 上記コードを参考に、「A列にコントロールツールの"スピンボタン"をリンクセルを相対参照にして縦に大量にコピー」すべく、コードを以下のように短絡的に書き換えてみましたが、エラーとなってしまいます。 ------------------------------------------------------------------ Sub SpinButton連続作成() Dim myspin As Object Dim i As Long Dim Sakuseisuu As Long Dim StartCell As Range '--------↓ここを変更--------- Sakuseisuu = 20 'チェックボックスの作成数 Set StartCell = Range("A1") 'スタートする位置 '--------↑ここを変更--------- For i = 0 To Sakuseisuu - 1 With StartCell.Offset(i) Set myspin = ActiveSheet _ .OLEObjects.Add(classtype:="Forms.SpinButton1.", _ Link:=False, DisplayAsIcon:=False, _ Left:=.Left, Top:=.Top, _ Width:=.Width, Height:=.Height) End With With myspin .LinkedCell = StartCell.Offset(i).Address .Object.Caption = "" .Object.Value = False End With Next End Sub ------------------------------------------------------------------ お詳しいかたがおられましたら、是非ともアドバイスを頂戴したく存じます。 さらにわがままを述べると、増減値をデフォルトの1から10に変更したく考えております。 何卒よろしくお願い申し上げます。

  • Excel VBA オプションボタンについて

    こんばんは オプションボタンが5つあり、 登録ボタンが1つあるユーザーフォームを作りました。 このオプションにチェックを入れずに登録ボタンを押したときに 「必ず選択してください。」とメッセージを表示し、再度入力させるようにしたいのですが、どうしたらよいのでしょうか。 Excelのバージョンは2003です。 調べたところ (1)で動きそうだ。ということが判ったのですがチェックを入れ値がtrueになるとエラーが発生して止まってしまいます。(理由がわかりません) Private Sub commandbutton2_click() Dim opt As ControlFormat, flg As Boolean flg = False For Each opt In frame1.Controls If opt.Value = True Then '←ここの行でtrueだった場合のエラーが発生してしまう。 flg = True Selection.Value = opt.Caption End If Next Unload userform1 End Sub (2)この方法で何とか動いたのですが、初めの方に書いたとおり、オプションボタンが選択されずに登録ボタンが押された場合、チェックするように促すメッセージを表示する方法がわかりません。また、できればユーザーホームの×ボタンを押せなくする方法もしくは、閉じられた場合にマクロを抜けるようにするにはどうしたらよいのでしょうか。宜しくお願い致します。 Private Sub commandbutton1_click() Dim i As Integer For i = 1 To 5 If Me.Controls("optionbutton" & i).Value = True Then Selection.Value = Me.Controls("optionbutton" & i).Caption End If Next i Unload userform1 End Sub

  • 指定範囲をアクティブセルに変更(エクセル)

    以下のマクロで、A1:E20にある全ての図形を削除できます。 Sub test()  Dim wLeft As Long  Dim wTop As Long  Dim wRight As Long  Dim wBottom As Long  Dim s As Object  With Range("A1:E20")   wTop = .Top   wLeft = .Left   wBottom = .Top + .Height   wRight = .Left + .Width  End With  For Each s In ActiveSheet.DrawingObjects   With s    If wTop <= .Top And _      wLeft <= .Left And _      wBottom >= .Top + .Height And _      wRight >= .Left + .Width Then     .Delete    End If   End With  Next End Sub "With Range("A1:E20")"を、任意のアクティブセルに変更するにはどうすればいいでしょうか? ちなみに、"With ActiveCell"や"With Range(ActiveCell.Address)"では、うまくいきませんでした。

  • エクセル2003のVBAで列を指定

    エクセルで特定の列の2~10行目に対して、ある作業をする場合、列を指定する方法は以下のどれがいいでしょうか?あるいはもっといい方法があれば教えてください。 実際には列は約40列(固定)、行は1~2万行(変動)程度で、作業はもっと複雑です。 Sub test01() Dim col Dim i As Long, n As Long For Each col In Array(1, 3, 7, 8, 11) '列番号で指定 For i = 2 To 10 n = n + 1 Cells(i, col).Value = n Next i Next col End Sub Sub test02() Dim col Dim i As Long, n As Long For Each col In Array("A", "C", "G", "H", "K") '列の記号で指定 For i = 2 To 10 n = n + 1 Cells(i, col).Value = n Next i Next col End Sub Sub test03() Dim col Dim i As Long, n As Long For Each col In Range("A2,C2,G2,H2,K2") 'セルで指定 For i = 2 To 10 n = n + 1 col.Offset(i - 2).Value = n Next i Next col End Sub

  • VBA ユーザーフォーム

    VBAにおけるユーザーフォームの件 今,下記の様なプログラムを組んでいるのですが,「myComboBox」に入った?値をこの後で使用したいのですが, どうすればいいのかわからなくて困っています. これで何がしたいかというと,ある個数分のコンボボックスを自動で作成して使用しようとしているのです. Private Sub UserForm_Initialize() Dim a As String Dim jj As Long Dim s As Integer Dim myComboBox As Control N = InputBox("抜き出したいデータ数は?") EffectiveRow = Range("A65536").End(xlUp).Row Effectivecolumn = Cells(2, 16384).End(xlToLeft).Column For s = 1 To N Set myComboBox = Me.Controls.Add("Forms.ComboBox.1") With myComboBox .Height = 20 .Width = 150 .Left = 120 .Top = (s - 1) * .Height + 10 End With For jj = 1 To Effectivecolumn myComboBox.AddItem Worksheets(1).Cells(1, jj).Value Next jj a = myComboBox.Value Worksheets(2).Cells(1, 1) = a Next s End Sub

  • オプションボタンについて

    VBAはまだやり始めたばかりで、ちょっとわからないので、教えて 下さい。 TextBox1~19に金額を入力すると、 TextBox60に小計 TextBox61に消費税 TextBox62に合計 が入るように設定してあります。 TextBox61のよこに OptionButton1 切捨て OptionButton2 切り上げ OptionButton3 四捨五入 OptionButton4 税込み(「-」を入力) を設定し、オプションボタンを選択するごとに、TextBox61の 消費税設定を変えたいと思っています。 標準では下記のコードでOptionButton1が選択されるように してあります。 オプションボタンで切り替えるにはどのようにしたら よいでしょうか。。。 Private Sub 合計Sub(ByVal myTextBox As MSForms.TextBox) Const cnsTax As Double = 0.05 Dim i As Long Dim v(1 To 19) As Long Dim y(60 To 62) As Long ' With myTextBox .Value = Format$(.Value, "#,##0") End With '再計算 On Error Resume Next For i = 1 To 19 v(i) = CLng(Me.Controls("TextBox" & i).Value) Next With Application.WorksheetFunction y(60) = .Sum(v) If myTextBox Is Me.TextBox61 Then y(61) = CLng(myTextBox.Value) Else y(61) = .RoundDown(y(60) * cnsTax, 0) End If y(62) = .Sum(y(60), y(61)) End With On Error GoTo 0 For i = 60 To 62 Me.Controls("TextBox" & i).Value = Format$(y(i), "#,##0") Next End Sub

  • VBA シート上のボタンクリックしたら実行

    お世話になっております。 シート上に、予定1、予定2…        実際1、実際2… という名前で作成したオートシェイプがあります。 このオートシェイプをクリックしたら、 既にあるオートシェイプ(矢印)を消し、 オートシェイプ(矢印)を作成するというものをしたいと思っています。 -------------------------- Sub Test() Dim TESTShape As Shape Dim i As Long Dim j As Long j = 1 For i = 5 To 64 With ActiveSheet.Range("J" & i) If i Mod 2 = 1 Then '2で割って余りが1なら Set TESTShape = ActiveSheet.Shapes.AddShape( _ msoShapeRectangle, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height) TESTShape.Fill.Visible = msoTrue TESTShape.Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = 41 TESTShape.Name = "予定" & j ' Else Set TESTShape = ActiveSheet.Shapes.AddShape( _ msoShapeRectangle, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height) TESTShape.Name = "実際" & j ' j = j + 1 End If End With Next End Sub -------------------------- 上記プログラムで、シート上にボタンを作成しました。 そのシートに直接プログラムを書き込み? Private Sub 予定1_Click() MsgBox "TEST" End Sub と試してみていますが、オートシェイプから シートプログラム?の実行はできないのでしょうか。 このシートは色んなシートにコピーして使おうと思っているため、 ボタンをおしたら矢印を消したり、追加したりする動作も他のブックにコピーしたいと思っています。 そのためシートに書き込もうとしているのですが、上手く行かず… 根本的に、なにか間違っているかもしれません。 シートに書き込むプログラムをどう書くべきなのかあまり良くわかっておりません…。 シート上のボタンをクリックしたら実行できるのは、 標準モジュールに書き込んだプログラムのみなのでしょうか? 質問がわかりにくく、説明不足の点も多々あるかもしれません。 その場合は、どんどん聞いてください。お願いします。 回答お待ちしております。

  • VBA

    選択したセルから複数画像を貼付け、画像の右セルに画像名を記入したいのですが、 画像名の記入方法がわからず、うまく動作できません。 ご教授の程、宜しくお願い致します。 例)A1セルを選択マクロ実行、画像3枚を貼付けたい:A1~A3セルに画像貼付け、B1~B3セルに画像名記入 ※※※※※※※※※※マクロ※※※※※※※※※※ Sub 画像貼付け() Dim i As Long, j As Long, k As Long Dim FileName As Variant Dim dblscal As Double Dim sp As Shape FileName = Application.GetOpenFilename( _ filefilter:="画像ファイル,*.jpeg;*.jpg;*.gif;*.JPG", _ MultiSelect:=True) Dim inp As Range On Error Resume Next Set inp = Application.InputBox( _ prompt:="マウスで開始セルを選択してください", _ Title:="開始セルを選択", _ Default:="マウスで開始セルを選択する", _ Type:=8) ''←メッセージボックスで開始セルを選択させる If Err.Number = 0 Then MsgBox mayrange.Address Else MsgBox "キャンセルしました。" End If j = inp.Row ''←選択した開始セルの行 k = inp.Column ''←選択した開始セルの列 For i = LBound(FileName) To UBound(FileName) Cells(j, k).Select With ActiveSheet.Shapes.AddPicture( _ FileName:=FileName(i), _ linktofile:=False, _ savewithdocument:=True, _ Left:=Selection.Left, _ Top:=Selection.Top, _ Width:=0, _ Height:=0) .ScaleHeight 1, msoTrue .ScaleWidth 1, msoTrue If Cells(j, k).Width / .Width < Cells(j, k).Height / .Height Then dblscal = WorksheetFunction.RoundDown(Cells(j, k).Width / .Width, 2) Else dblscal = WorksheetFunction.RoundDown(Cells(j, k).Height / .Height, 2) End If .Width = .Width * dblscal * 0.97 .Height = .Height * dblscal * 0.97 .Left = .Left + (Cells(j, k).Width - .Width) / 2 .Top = .Top + (Cells(j, k).Height - .Height) / 2 End With k = k + 0 j = j + 1 Next i End Sub

  • VBAでフォームにおけるコマンドが実行されません。

    なんどもすいません。二列目に、二桁の整数の足し算を出題することができるたし算の作問プログラムと、続いて三列目に、足し算の解答をして、それの正誤を確かめるプログラムを、それぞれフォームで”問題”、”採点”とした時、一回フォームのウィンドウを閉じてしまうと”採点”のコマンドを押しても、うまく実行されません。 im Ans() As Long Dim n As Variant Private Sub monndai_Click() Dim x As Long, y As Long Columns("B:F").Clear n = InputBox("問題数は?") If Not IsNumeric(n) Then Exit Sub If n <= 0 Then Exit Sub ReDim Ans(n) As Long For i = 1 To n Randomize x = Int(Rnd * 100) Randomize y = Int(Rnd * 100) Ans(i) = x + y Cells(i, 2) = "(" & i & ") " & x & " + " & y & " = " Next i End Sub Private Sub saiten_Click() t = 0 Dim i As Long For i = 1 To n If Cells(i, 3) = Ans(i) Then Cells(i, 4) = "○": t = t + 1 Else Cells(i, 4) = "×": End If Next i tokutenn = "貴方の正答率は" & Int(t / n) & "%です" End Sub (注)tokutennはフォームのテキストボックスのオブジェクト名です。

専門家に質問してみよう