• 締切済み

VBAで図のindex番号を変数に挿入したら・・・

VBAで、オートシェイプのインデックス番号を変数に挿入すると途中で初期化されてしまいました。 VBAのチェックボックスを用いて各チェックボックスごとに、 ある画像の座標からAX,AY+aの位置に幾つかの円を表示し、 チェックを外すと作成した円を削除するプログラムを作っています。 また、最終的にはチェックボックスを複数(10~15)個作ってそれに対応した 円だけを表示するようなプログラムにしたいと考えています。 下のプログラムをデバックすると※2の部分で変数の値が""、 最終的に※3の行で止まってしまいます。 Option Explicit Public i As Long '繰り返し変数定義 Public ix As Integer '繰り返し回数変数定義 Public X As Integer '基準位置情報変数定義(x軸) Public Y As Integer '基準位置情報変数定義(y軸) Public AX As Integer '移動位置情報変数定義(x軸) Public AY As Integer '移動位置情報変数定義(y軸) Private Sub CheckBox1_Click() Static O() As Variant Y = ActiveSheet.Shapes("Picture 1“).Top '図の上端の位置を変数に挿入 X = ActiveSheet.Shapes("Picture 1").Left '図の左端の位置を変数に挿入 i = 0 ix = 3 '繰り返し回数を変数に挿入 ReDim O(ix) AX = X + 500 AY = Y + 280 '--------------------------------------------------- If CheckBox1.Value = True Then 'チェック有 Do Until i = ix ActiveSheet.Shapes.AddShape(msoShapeOval, AX + (i * 24), AY, _ 16, 16).Select O(i) = Selection.Index MsgBox O(i) ※1 i = i + 1 Loop End If MsgBox O(i) ※2 If CheckBox1.Value = False Then 'チェック無 i = 0 Do Until i = ix ActiveSheet.Shapes.Range(O(i)).Delete ※3 i = i + 1 Loop End If End Sub ↑のようなプログラムを組むと、チェック有の If 終了時 ※2のMsgBox O(i)でO(i)が初期化?されて値が表示されなくなってしまっていま す。 IFの処理中(※1)ではO(i)の値が正常に出力されていたので、 IF終了時に値がなくなっていると思うのですが、 どういった現象が起きているのでしょうか? また、作成した円を上手く削除するにはどうすれば良いでしょうか? この形にこだわっているわけではないので、もっといい方法があれば ご教授頂けると幸いです。 どうかよろしくお願いします。

みんなの回答

  • mitarashi
  • ベストアンサー率59% (574/965)
回答No.1

Index番号は、図形が削除されると振り直されるのでしょう。 Sub test() Dim oval1 As Shape Dim oval2 As Shape Set oval1 = ActiveSheet.Shapes.AddShape(msoShapeOval, 10, 10, 16, 16) Debug.Print ActiveSheet.DrawingObjects(oval1.Name).Index '1 Set oval2 = ActiveSheet.Shapes.AddShape(msoShapeOval, 40, 10, 16, 16) Debug.Print ActiveSheet.DrawingObjects(oval2.Name).Index '2 oval1.Delete Debug.Print ActiveSheet.DrawingObjects(oval2.Name).Index '1  '番号が振り直されて2から1に変わってしまっている。 End Sub オブジェクト変数の配列に入れておけば、配列の添字でIndexで行いたかった様にアクセス出来ると思います。 下記は、Stopのところから継続実行させると、つつがなく全削除できます。ご参考まで。 Sub test2() Dim ovals(10) As Shape Dim myArray As Variant Dim i As Long, j As Long myArray = Array(10, 3, 1, 4, 7, 9, 5, 8, 6, 2) For i = 1 To 10 Set ovals(i) = ActiveSheet.Shapes.AddShape(msoShapeOval, 20 * i, 10, 16, 16) Next i Stop For i = 1 To 10 ovals(myArray(i - 1)).Delete Next i End Sub

関連するQ&A

  • Excel VBAでCheckboxの名前を変数にとって値を調べたい

    Excel VBAでCheckboxの名前を変数にとって値を調べたいのです. シートにCheckboxがたくさん貼ってあり名前とOn,Offを調べたいのですが下記では名前は調べられてもOn,Offが確認できないのですが On,Offを別変数にとる場合タイプはなににすればいいでしょうか。 たとえば dim i as integer dim checkname() dim checvalue() as ???? i=0 for i=1 to 2 If Mid(ActiveSheet.Shapes(i).Name, 1, 5) = "Check" Then i=i+1 redim preserve checkname(i) checkname(i)=ActiveSheet.Shapes(i).Name redim preserve checvalue(i) checvalue(i)=ActiveSheet.Shapes(i).value <---これではエラー end if next i

  • ShapeのVBAの中での取り扱い

    ShapeのVBAの中での取り扱いに関して、サジェスチョン願います。 Shapeに文字が書き込まれていない段階で、選択して文字を読み込み判定しようとするとエラーとなります。 下記のVBAでは、5番目のShapeが該当します。 このエラーを防ぐためには、On Error Resume Nextが有効ですが、他の方法を探しています。例えば、charactor=trueみたいなもの。 ----- Sub Shapeの調査() Dim nametemp(10) As String Dim temp As Integer Dim i As Integer Dim aaa As Variant 'On Error Resume Next ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, 50, 50).Select ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 150, 150, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeRectangle, 200, 200, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeOval, 250, 250, 50, 50).Select temp = ActiveSheet.Shapes.Count For i = 1 To temp ActiveSheet.Shapes(i).Select nametemp(i) = ActiveSheet.Shapes(i).Name Next For i = 1 To temp / 2 + 1 '4つのshapeに対し、文字を書き込もうとする ActiveSheet.Shapes(nametemp(i)).Select Selection.Characters.Text = "" Next For i = 1 To temp / 2 '3つに対して、文字を書き込む ActiveSheet.Shapes(nametemp(i)).Select Selection.Characters.Text = "zzzzz" Next For i = 1 To temp ActiveSheet.Shapes(nametemp(i)).Select aaa = Selection.Characters.Text '<--5番目のShapeに対し If aaa = "zzzzz" Then MsgBox (aaa)'<--errorとなる。 Next End Sub

  • VBAの変数について

    VBAでUserFormからデータを入力します。 入力された各データをTarget1~Target20に代入します。 各Targetにデータが入っている場合は、配列K(i)に「1」を格納します。 そこで、Target "1"~"20" を変数iであらわしたいのですが、どのように表現したらよいのでしょうか。 Dim i As Integer Dim K(20) As Integer Target1 = TextBox1.Value Target2 = ComboBox1.Value : : Target19 = TextBox12.Value Target20 = ComboBox8.Value For i = 1 To 20 If 『  ?   』 <> "" Then K(i) = 1 EndIf Next i

  • VBAで変数定義を変更する方法

    Data_Typeという変数の中に文字列doubleが入っていたら、 AIyyという変数をdoubleで定義、 longが入っていたらlongで定義するというプログラムを作りたいのですが If Data_Type = "double" Then Dim AIyy As Double ElseIf Data_Type = "long" Then Dim AIyy As Long End If と書くと、定義が重複しているというエラーが表示されてうまくいきません。 これはどうすれば良いでしょうか? それと一度integerで定義した変数をlongなどに定義を変更したい場合どのようにすれば良いでしょうか?

  • VBAの変数の定義について

    いつもお世話になっております。 VBAでの変数の定義についてお尋ねします。 VBAの勉強を始めたばかりの超初心者です。 I.チェック:A列とC列の和をE列に記載してその正誤を判定。 II.リセット:E列をクリアし、A列、C列の数字をランダムに置き換える。 という練習問題のコードを私が書いたものです。 以下について質問させていただきます。 (1)下記はモジュールレベルでの変数の宣言になると思いますが、変数の定義?例えば、最終値 = Range("A4").End(xlDown).Rowはそれぞれのプロシージャで定義しなければならないのでしょうか? (2)モジュールレベルでの変数の宣言は,Dimではなく、Privateでやるべきなのでしょうか? (3)何か指摘事項があれば、教えてください。 超初歩的な質問で、申し訳ありませんが、よろしくお願いいたします。 Option Explicit Dim i As Integer '処理用カウンタ変数 Const 初期値 As Integer = 4 '表の最初 行 Dim 最終値 As Integer '表の最終 行 Sub チェック() 最終値 = Range("A4").End(xlDown).Row '表の最終行番号を取得 For i = 初期値 To 最終値 Step 1 If Cells(i, 1).Value + Cells(i, 3).Value = Cells(i, 5).Value Then 'A列+B列 Cells(i, 5).Font.Color = vbBlue '回答が正ならフォントを青 Else Cells(i, 5).Font.Color = vbRed '回答が誤ならフォントを赤 End If Next i End Sub Sub リセット() 最終値 = Range("A4").End(xlDown).Row '表の最終行番号を取得 For i = 初期値 To 最終値 Step 1 Cells(i, 5).ClearContents '回答をクリア Cells(i, 5).Font.Color = vbBlack '回答のフォントを黒 Cells(i, 1).Value = Int(Rnd * 100) 'A列にランダムな数値 Cells(i, 3).Value = Int(Rnd * 100) 'C列にランダムな数値 Next i End Sub

  • VBAでは角度はどっち回りですか?

    VBAでインボリュート曲線を描画するプログラムを書いたのですがなぜか時計回りになってしまいます。 自分は角度は3時の方向から反時計回りで増えていくと思っているのですがVBAでは逆回転なのでしょうか。 どっち回りか教えてください。 参考に作ったプログラムを書きます Sub インボリュート() '---------変数の宣言 Dim x1 As Double Dim y1 As Double Dim x2 As Double Dim y2 As Double Dim pai As Double Dim R As Integer '半径 Dim L As Double '-----値を初期設定 R = 50    L = 0 pai = 3.1415926535897 For θ = 0 To 3 * pai Step (pai / 1000) L = θ * R x1 = R * Cos(θ) y1 = R * Sin(θ) x2 = x1 + L * Cos(θ + 3 / 2 * pai) y2 = y1 + L * Sin(θ + 3 / 2 * pai) '---------シート上に図形を描画する ActiveSheet.Shapes.AddShape msoShapeOval, 500 + x1, 500 + y1, 1, 1 ActiveSheet.Shapes.AddShape msoShapeOval, 500 + x2, 500 + y2, 1, 1 Next θ End Sub ちなみにExcel2000です

  • vbaで標準モジュールの変数を引用したい

    vbaを勉強しています。以下のようなコードを書きました。(長くなってしまい申し訳ありません) ユーザーが指定した日付で工程表を作成したいのですが、イベントプロシージャ?(と呼ぶかどうかよくわからないのですが)がうまく動きません。標準プロシージャのイン尾うっとボックスで取得した日付をイベントプロシージャで使うにはどうしたらよいでしょうか。 また、インプットボックスで日付を指定する際に、既存にある日付を削除してから記述をしたいのですが、どのようにしてよいかわかりませんでした。 ↓標準モジュール Const HIDUKE_ADRS As String = "E2" '日付セル位置 Const MONTH_OFST As Integer = 0 '月の行の位置 Const DAY_OFST As Integer = 1 '日の行の位置 Const WKDAY_OFST As Integer = 2 '曜日の行の位置 Const FIRST_DAY As Integer = 1 '月の変わり目の日 Dim myDate As Date '処理中の日付を表す変数 Dim baseCell '基点セル Dim LC As Long '最終列 Dim LR As Long '最終行 Sub 日付描画() Dim orgDate As Date Dim dstDate As Date orgDate = InputBox("開始年月日を入力してください。例:2012/5/1") dstDate = InputBox("終了年月日を入力してください。例:2013/3/31") Set baseCell = Range(HIDUKE_ADRS) '基点セルを日付にセット  ↓以下の作業をする前に、既に記述されている日付を削除したい。 '----------- 月と日と曜日を描画 ----------- baseCell.Activate '基点セルをアクティブセル化 myDate = orgDate 'myDateを開始年月日にセット Do Until myDate > dstDate '処理中の日が終了年月日に達するまでループを回す With ActiveCell '月の変わり目の日と表の最初の行のみ月を描画 If Day(myDate) = FIRST_DAY Or .Column = baseCell.Column Then .Value = Month(myDate) & "月" '月を入力 .Borders(xlEdgeLeft).Weight = xlThin 'セル左辺に罫線を引く End If .Interior.Color = vbBlue .Offset(DAY_OFST, 0).Value = Day(myDate) '日を入力 .Offset(DAY_OFST, 0).ColumnWidth = 3 .Offset(WKDAY_OFST, 0).Value = WeekdayName(Weekday(myDate), True) '曜日を入力 '日の列~スケジュール欄の列に格子状の罫線を引く Range(.Offset(DAY_OFST, 0), .Offset(WKDAY_OFST, 0)).Borders.Weight = xlThin '日曜のセル背景を黄色にする If Weekday(myDate) = vbSunday Then Range(.Offset(DAY_OFST, 0), .Offset(WKDAY_OFST, 0)) _ .Interior.Color = vbYellow End If myDate = DateAdd("d", 1, myDate) '処理中の日付を1日進める .Offset(0, 1).Activate 'アクティブセルを1行進める End With Loop End Sub ↓イベントプロシージャ(と呼ぶのでしょうか?) Private Sub Worksheet_Change(ByVal target As Range) End Sub Private Sub Worksheet_SelectionChange(ByVal target As Range) ' 工程ライン作成 Dim orgDate As Date Dim myDate As Date '処理中の日付を表す変数 Dim X1 As Single Dim Y1 As Single Dim X2 As Single Dim Y2 As Single Dim kiten As Range Dim Kikan As Long Dim start As Long Dim i As Long Dim LR As Long '最終行 LR = Range("D65536").End(xlUp).Row Set kiten = Range("E4") If target.Column = Range("C:D").Column Then Call 日付描画(orgDate)  ←ここが駄目なようです。。 myDate = orgDate On Error Resume Next For i = 5 To LR ActiveSheet.Shapes("KOUTEILine " & i).Delete Next i For i = 5 To LR start = Cells(i, 3).Value - myDate Kikan = Cells(i, 4).Value - Cells(i, 3).Value X1 = Range(Cells(1, 1), Cells(1, 4 + start)).Width Y1 = Range(Cells(1, 1), Cells(i - 1, 1)).Height + Cells(i, 1).Height / 1.1 X2 = Range(Cells(1, 1), Cells(i, start + 5 + Kikan)).Width Y2 = Y1 With ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2) .Name = "KOUTEILine " & i .line.EndArrowheadStyle = msoArrowheadTriangle .line.ThemeColor = xlThemeColorAccent1 .line.Weight = 3 End With Next i End If End Sub よろしくお願いいたします。

  • やはり図形のクリアで実行時エラー1004

     図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー 「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。) 対処法がありましたらお願いします。 Windows7・SP1 Office2010 Sub 図形の貼付け() Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 9 To 99 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Cells(i + 1, j).Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 5: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 2).Select ActiveSheet.Paste Case 6: ActiveSheet.Shapes("円1").Select Selection.Copy Cells(i, j).Select ActiveSheet.Paste End Select Next Next End Select End Sub Sub 図形のクリア() Dim myRng As Range Set myRng = Range("I10:CW43") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing  (ここで実行時エラー1004になります。) Then sp.Delete End If Next Set myRng = Nothing End Sub

  • ExcelのAutoFilter への変数の使用がうまく行きません!

    ExcelのAutoFilter への変数の使用がうまく行きません! Windows XP Home Edition SP3 Office XP Personal 2002 Excel 2002 下記の NNN に 「 InputBox に 入力した整数 」 を変数で使用したいのですが、 どのようにすればよろしいでしょうか? 何卒、ご教示のほどをお願い致します。 Sub TEST1() Dim NNN As Integer Dim msg As String Dim i As Integer Application.ScreenUpdating = False   msg = "【整数】 を入力してください。"   NNN = InputBox(msg)   If ActiveSheet.AutoFilterMode Then    With ActiveSheet.AutoFilter    For i = 88 To 90    .Range.Rows(1).Cells(i).AutoFilter Field:=i, Criteria1:="<=NNN" '←この NNN です    Next i   End With   End If Application.ScreenUpdating = True End Sub

  • エクセルVBAでの変数

    いつもお世話になります。 今回の『壁』は”変数”です。 変数の中に更に変数を持たせることはできますか? 何をしたいかと言いますと… dim mon1 as string dim mon2 as string dim mon3 as string dim mon4 as string dim mon5 as string dim tue1 as string dim tue2 as string …というように月曜から日曜までの頭3文字プラス1~5の組み合わせの変数を作りたいのですが、 この調子で作っていくと35コになってしまいます。 そこで、曜日の頭3文字より後ろは決まって1~5のため、 dim i as integer for i = 1 to 5 next i …と組み合わせられないかと思ったのです。 どなたか知恵をお貸しください。 よろしくお願いします。

専門家に質問してみよう