- ベストアンサー
VBAでオプションボタンを透過
doara_2011の回答
Next i の前の行あたりに、以下を挿入すると取りあえずできます。 opt.Interior.Pattern = xlNone 上記で取りあえずと書いたのは、Excel2003だと、フォーカスのあるコントロール は透過はされないようですが、フォーカスが別のコントロールに移っても透過 されないままの場合があるようです。透過してくれる場合もあって、その法則性 はよくわからないです。 Excel2010では、透過されないのは現在フォーカスのあるコントロールのみだけ で、他のコントロールはちゃんと透過してくれています。 以上
関連する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
- ベストアンサー
- その他MS Office製品
- （ＶＢＡ）スピンボタンの大量コピー（相対参照）
お世話になります。質問させていただきます。 表題件ですが、ＥＸＣＥＬにて 「Ａ列にコントロールツールの"スピンボタン"をリンクセルを相対参照にして縦に大量にコピー（さらに増減値をデフォルトの１から１０に変更）」したいと考えています。 以下に記載したＶＢＡコードは、こちらと同様のＱ＆Ａサイトにて見つけてきた「Ａ列にコントロールツールの"チェックボックス"をリンクセルを相対参照にして縦に大量にコピー」するコードです。 先ずは参考までにご確認ください。 ----------------------------------------------------------------- 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 ------------------------------------------------------------------ 上記コードを参考に、「Ａ列にコントロールツールの"スピンボタン"をリンクセルを相対参照にして縦に大量にコピー」すべく、コードを以下のように短絡的に書き換えてみましたが、エラーとなってしまいます。 ------------------------------------------------------------------ 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 ------------------------------------------------------------------ お詳しいかたがおられましたら、是非ともアドバイスを頂戴したく存じます。 さらにわがままを述べると、増減値をデフォルトの１から１０に変更したく考えております。 何卒よろしくお願い申し上げます。
- ベストアンサー
- オフィス系ソフト
- Excel VBA オプションボタンについて
こんばんは オプションボタンが５つあり、 登録ボタンが１つあるユーザーフォームを作りました。 このオプションにチェックを入れずに登録ボタンを押したときに 「必ず選択してください。」とメッセージを表示し、再度入力させるようにしたいのですが、どうしたらよいのでしょうか。 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
- ベストアンサー
- その他MS Office製品
- VBA シート上のボタンクリックしたら実行
お世話になっております。 シート上に、予定１、予定２… 実際１、実際２… という名前で作成したオートシェイプがあります。 このオートシェイプをクリックしたら、 既にあるオートシェイプ(矢印）を消し、 オートシェイプ（矢印）を作成するというものをしたいと思っています。 -------------------------- 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で割って余りが１なら 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 と試してみていますが、オートシェイプから シートプログラム？の実行はできないのでしょうか。 このシートは色んなシートにコピーして使おうと思っているため、 ボタンをおしたら矢印を消したり、追加したりする動作も他のブックにコピーしたいと思っています。 そのためシートに書き込もうとしているのですが、上手く行かず… 根本的に、なにか間違っているかもしれません。 シートに書き込むプログラムをどう書くべきなのかあまり良くわかっておりません…。 シート上のボタンをクリックしたら実行できるのは、 標準モジュールに書き込んだプログラムのみなのでしょうか？ 質問がわかりにくく、説明不足の点も多々あるかもしれません。 その場合は、どんどん聞いてください。お願いします。 回答お待ちしております。
- ベストアンサー
- Excel（エクセル）
- 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
- ベストアンサー
- Visual Basic
- EXCEL2007 VBA グラフサイズ修正バグ？
下記のようなグラフのサイズ調整するVBAプログラムをEXCEL２００７で動かしました。 VBEで実行すると正常に動作します。 シートに図形を設置し、その図形にマクロを登録して実行すると、 グラフが3画面位広がってしまいます。 図形にマクロ登録してグラフ調整を正常に動かすことはできないのでしょうか? ----------------------------------------------------- 'グラフの再調整を行うサブルーチン Sub chartRerange() Dim wb As Workbook Dim strWbName As String Dim myRng1, myRng2, myRng3 As Range Dim myChart As Shape Dim rngTarget As Range '開いているすべてのワークブックを処理対象とする For Each wb In Workbooks strWbName = wb.Name '「月度」が含まれているならば処理 If InStr(strWbName, "月度") <> 0 Then Set myRng1 = wb.Worksheets(2) Set myRng2 = wb.Worksheets(3) For Each myChart In myRng1.Shapes 'グラフならば If (TypeOf myChart.OLEFormat.Object Is ChartObject) Then Select Case myChart.Name Case "chart1" Set rngTarget = Range("B24:AG42") End Select 'グラフを指定したエリアに配置する With myChart .Top = rngTarget.Top .Left = rngTarget.Left .Width = rngTarget.Width .Height = rngTarget.Height End With End If Next End If Next MsgBox "処理完了" Set wb = Nothing Set myRng1 = Nothing Set myRng2 = Nothing Set myChart = Nothing Set rngTarget = Nothing End Sub
- ベストアンサー
- オフィス系ソフト
- Excel 2007 <VBAでグラフの操作>
Excel 2007 <VBAでグラフの操作> 現在すでにあるグラフを修正しています。 下記マクロでは「各グラフに系列が2つあり、その1つ目を削除して残る1つのデータ範囲（X軸の値)を再設定する」という内容です。 下記マクロではFor構文冒頭のSet～の行で、 「実行時エラー '1004'： 'Cells'メソッドは失敗しました:'_Global'オブジェクト」 とのエラーが出ます。 このエラーについて検索してみたのですが、これといったものが見つからなかったので、このマクロでおかしなところがあれば直接指摘していただけないでしょうか。 よろしくお願いします。 Private Sub Test_Arrange() Dim MyRng As Range Dim R As Integer Dim n As Integer Dim i As Integer n = 10 R = Sheets("Sheet1").Range("A1").End(xlDown).Row For i = 1 To n Set MyRng = Sheets("Sheet1").Range(Cells(2, 2 * n + 3), Cells(R, 2 * n + 3)) Charts(i).SeriesCollection(1).Delete Charts(i).SeriesCollection(1).XValues = MyRng Next i End Sub
- ベストアンサー
- その他MS Office製品
- エクセルのウインドウをど真ん中に表示したい
Sub Macro2() Dim i As Long Dim j As Long i = Application.UsableHeight / 20 j = Application.UsableWidth / 40 With ActiveWindow .Top = i .Left = j End With With ActiveWindow .Height = i * 18 .Width = j * 38 End With End Sub これで、エクセルのアプリケーション内にウインドウを表示させたくて、 上下左右同じ長さの空白を入れたいのですが 左側の空白が多いです。 何故均等にならないのでしょうか？
- ベストアンサー
- その他MS Office製品
お礼
早速ありがとうございます。 opt.Interior.Pattern = xlNone 試しました。 ちゃんと透過したオプションボタンが現われました。 でもおっしゃるとおり、クリックすると透過されませんし、一旦そうなると別のボタンをクリックしても透過されないままですね。（何度かいじるとまた透過されたりする・・・） 何か変な動きですね。
補足
今日、エクセル2007にさわる機会があったので試しました。 2003と同じ結果でした。 2010じゃなきゃだめなんですね。 これはエクセルのバグなんでしょうか。