• 締切済み

オートシェイプの位置がずれる件について教えてください

ＶＢのエクセル操作で繰り返し処理を行うとオートシェイプの開始位置がずれていくのですが対処方法を教えてください。 Excel ver.2007 OS XP pro プログラム With xlSheet.Shapes.AddShape(msoShapeOval, _ xlSheet.Range("E1").left + 5, xlSheet.Range("A" & Cell_Kaigyou).top + 8, xlSheet.Range("A1").Height, xlSheet.Range("A1").Width) Cell_Kaigyou = Cell_Kaigyou + 1 'セル行数

みんなの回答

  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

こんにちは。 > xlSheet.Range("A" & Cell_Kaigyou).top + 8 を AddShape メソッドの第3引数にし、Top を変化させているのだから、 ずれて当然なのでは？ expression.AddShape(Type, Left, Top, Width, Height) ご質問の意味を取り違えてますか？

swqamy
質問者

お礼

ありがとうございます。 自己解決しました。

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • VBAでオートシェイプの制御？

    エクセルマクロでセルにオートシェイプを張る方法を調べていて、ここで丁度いいのを見つけました。 http://oshiete1.goo.ne.jp/kotaeru.php3?q=808898 見つけた下記のマクロを実際にやってみました。 A1に１を入れるとB2にハートマークが出ます。 しかし、さらに２を入力してもB2のハートは削除されてくれません。 さらに１をいれると、ハートの上にハートが重なってしまいます。 １ならハート、それ以外の入力ならハートが消えるようにするにはどうすればいいのでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) If Target <> Range("A1") Then Exit Sub If Target.Value = 1 Then With ActiveSheet.Range("B2") ActiveSheet.Shapes.AddShape(Type:=msoShapeHeart, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select End With End If End Sub

  • エクセルVBA　オートシェイプを操作したいです

    エクセルでセルの入力内容によって楕円をオートシェイプで出現させたいと思います。 http://oshiete1.goo.ne.jp/qa809742.htmlで見つかったものを参考にし、 Private Sub worksheet_Activate() Dim Shp As Shape Set P11 = Range("P11") If P11 Is Nothing Then Exit Sub If P11.Value = 1 Then For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N14:N15")) Is Nothing Then Shp.Delete End If Next Shp With ActiveSheet.Range("N14:N15") ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left,TOP:=.TOP,Width:=.Width,Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End With Range("N14").Select Else For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N14:N15")) Is Nothing Then Shp.Delete End If Next Shp End If If P11.Value = 2 Then For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N16")) Is Nothing Then Shp.Delete End If Next Shp With ActiveSheet.Range("N16") ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left, TOP:=.TOP, Width:=.Width, Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End With Range("N16").Select Else For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N16")) Is Nothing Then Shp.Delete End If Next Shp End If End Sub とつなげて見ました。 動くには動くのですが、データ元のセルがP11からT30と100セルあり、さらにP11に入力されるデータが１，２，３，４の4種類、AQ11に５，６，７，８，９の5種類などと、ばらばらです。 P11に１が入力されるとN14:N15(結合されています)に円が入り、２が入力されるとN16に円が入る。 Q11に５が入力されるとR13に円が入り、６が入力されるとR14:R15に円が入る・・・・のようにしたいのです。 一生懸命、セルNo.を打ち込んでいたら、 「コンパイルエラー：プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。

  • #の意味

    エクセルでオートシェイフ゜のマクロの記録をとったときに Sub Macro2() ActiveSheet.Shapes.AddShape(msoShapeFlowchartConnector, 100, 100#, 100, 100).Select End Sub のように TOPの後にシャーフ゜が入ります。 （expression.AddShape(Type, Left, Top, Width, Height)） これはどういう意味でしょうか？ シャーフ゜があってもなくても新規のオートシェイフ゜が挿入できます。

  • excelVBAのオートシェイプ幅設定について

    いつもお世話になっております。 以前こちらでお教えしてもったＶＢＡを試してみたのですが、うまくいきません。 自分なりに調べてきたつもりですが、オートシェイプの幅を時間と結びつけるやり方がよくわかりません。 A2=14:30 Ａ3=15:15 Ａ4=45 　　　　　Ｂ　　Ｃ　　Ｄ　… 3行目　０　　　1　　2　　… で、4行目に、Ａ2～Ａ３のオートシェイプを時間の列と対応するよう作成したいのですが、幅が長くなりすぎてしまいます。 Columns("A:Z").ColumnWidth = 9 変数S = Cells(4, 2) 変数E = Cells(4, 25) ★変数Width = 変数E.Left + 変数E.Width - 変数S.Left 変数Height = 変数E.Height 変数Top = 変数S.Top ★変数Min = 変数Width / 1440 ★変数Start = Cells(1, 2).Value * 1440 * 変数Min + 変数S.Left 変数End = Cells(1, 3).Value * 24 ★変数2Width = Cells(1, 4).Value * 変数Width ActiveSheet.Shapes.AddShape(msoShapeRectangle, 変数Start, 変数Top, 変数2Width, 変数Height).Select となっていますが、 ★部分がよくわかりません。 変数Width = 変数E.Left + 変数E.Width - 変数S.Left を求めて、なぜ、A4に*ことになるのか。 1440はどこからきた数字なのか。 そもそもこの式自体が間違っているのでしょうか。 トンチンカンな質問になっていたら申し訳ございません。 よろしくお願いします。

  • 選択したセルにピッタリ合うオートシェイプの挿入

    よろしくお願いいたします。 下記のコードは行方向では選択したセルとピッタリに四角のオートシェイプが挿入できるのですが、列方向では常に１行です。 横方向も選んだ範囲だけ広がるようにするにはどう変えたらよいでしょうか。 Set shrect = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ Selection.Left, Selection.Top, Selection.Offset(0, 1).Left - Selection.Left, _ Selection.Height)

  • EXCEL VBAでオートシェイプの重なりを検知するには？

    いつも拝見させていただいております。 教えてください。 excelのバージョンは2002です。 ひとつのオートシェイプに他のオートシェイプが重なっていた場合、重なっているオートシェイプを移動し、重ならないようにしたいのですが、どうやればよいでしょうか？ Shapeオブジェクトの .Left .Top .Height .Width を駆使してチェックするしかないでしょうか？ 簡単にできる方法がありましたら、お教え願います。

  • VB6 オートシェイプ描画

    VB6 オートシェイプ描画 VB6でExcel,2000(ActiveSheet)にオートシェイプを使用したいのですが、エラーが出てしまいます。 コマンドボタンクリック時、エラー ------------------------------- 実行時エラー'1004': 指定された値は境界を超えています。 ------------------------------- AddLineは出来たのですが四角や円がこのエラーです。どこが間違えているのでしょうか？ 宜しくお願いします。 Private Sub CB13_Click() Dim xlApp As Excel.Application Set xlApp = GetObject(, "Excel.Application") xlApp.ActiveSheet.Shapes.AddLine 50, 50, 100, 100 '(OK) xlApp.ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 100, 100).Select '(NG) Set xlApp = Nothing End Sub

  • 挿入したオートシェイプが文字入力待機状態にする方法

    昨日HohoPapaさんに選択したセルとピッタリ合うオートシェイプの挿入の仕方を教えていただきました。 今度は、オートシェイプがアクティブ状態とでもいうのでしょうか、挿入後すぐにタイプしたら文字が入力できる状態にする方法を教えていただきたいです。フォントのサイズ、位置は不問で黒色で入力できればと思います。 よろしくお願いいたします。 Set shrect = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ Selection.Left, Selection.Top, Selection.Width, _ Selection.Height) shrect.Fill.ForeColor.SchemeColor = 22 'Grey 'shrect.Font.Color = vbBlack ←うまくいかなかった部分

  • JavaScriptで書き出したオートシェイプにテキストを挿入したいの

    JavaScriptで書き出したオートシェイプにテキストを挿入したいのですができません。 先日、ExcelのシートにJavaScriptでオートシェイプを書き出す方法を質問した者です。 今度は書き出したオートシェイプにテキストを挿入したいのですが上手くいきません。 どうすれば良いのか教えてください。 ※またもやJavaScriptで解決したいです。 なお、現在悩み中のソースは以下のようです。 ※教えて頂いたソースほとんどそのままですが... function createShapes() { var excel = new ActiveXObject( "Excel.Application" ); excel.visible = true; var sheet = excel.Workbooks.Add().activeSheet; // オートシェイプ挿入：引数の１０５は吹き出しを示す sheet.Shapes.AddShape(105, 123, 37.5, 151.5, 94.5); // ココでメソッド、プロパティがないとエラーになってしまう... 　sheet.Shapes("AutoShape 1").Characters.Text = "ほげほげ"; } よろしくお願いします。

  • オートシェープをグルーピングして動作させたい

    office365 ２つのオートシェープをグルーピングして図形を動作させたい 下記で kibanは平行四辺形のオートシェープ yajirushiは右向き矢印のオートシェープ で、それぞれ、ある範囲で左から右に移動を繰り返します。 この２つのオートシェープをグルーピングして 平行四辺形の右側に矢印を配置した状態で、そのグルーピングされた図形の動作を繰り返す様にしたいのですが、 その内容が分からないのでコードで教えていただきたく、よろしくお願いします。 #If Win64 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else ' Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Sub kiban() shape_delete Dim ws2 As Worksheet Dim i As Integer Set ws2 = Sheets("sheet1") ws2.Shapes.AddShape(msoShapeParallelogram, 2265, 354, 46, 20).Select With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 176, 80) .Transparency = 0 .Solid End With ws2.Shapes.AddShape(msoShapeParallelogram, 2265, 458, 20, 20).Select ws2.Shapes(ws2.Shapes.Count).name = "kiban" For i = 0 To 30 If i = 30 Then i = 0 End If ws2.Shapes(1).Left = i * 3 + 365 ws2.Shapes(1).Top = 458 Sleep 100 DoEvents Next i ws2.Shapes("kiban").delete End Sub Sub yajirushi() shape_delete Dim ws As Worksheet Dim i As Integer Set ws = Sheets("sheet1") ws.Shapes.AddShape msoShapeRightArrow, 2265, 458, 20, 20 ws.Shapes(ws.Shapes.Count).name = "yajirushi" For i = 0 To 30 If i = 30 Then i = 0 End If ws.Shapes(1).Left = i * 3 + 420 ws.Shapes(1).Top = 458 Sleep 100 DoEvents Next i ws.Shapes("yajirushi").delete End Sub Sub shape_delete() Dim shp As Shape Dim rng As Range Range("P22:CM28").Select If TypeName(Selection) <> "Range" Then Exit Sub For Each shp In ActiveSheet.Shapes '‘ 図形の配置されているセル範囲をオブジェクト変数にセット Set rng = Range(shp.TopLeftCell, shp.BottomRightCell) '‘ 図形の配置されているセル範囲と '‘ 選択されているセル範囲が重なっているときに図形を削除 If Not (Intersect(rng, Selection) Is Nothing) Then shp.delete End If Next End Sub

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する