• ベストアンサー

オートシェイプがずれる

エクセルで、選択した項目によって○をつけるコードを書いたのですが、 自分のパソコン(エクセル2003)では、思ったところにいくのですが、 知人のパソコン(エクセル2002,SP3)ではずれて表示されます。 ActiveSheet.Shapes("xlBunsyo").Select Selection.ShapeRange.Left = 437 Selection.ShapeRange.Top = 18 このようなコードなのですが、確認のため違うパソコン(エクセル2002,SP3)で確認してもうまく行きます。 知人の仕事場ではエクセルを使ってなにかシステムを使用している用のですが、知人が離れているため現象を確認できません。 知人も他のパソコンで確認したところ8台中1台はうまく行ったようです。 オートシェイプをしてするにあたり、何か他の設定があるのでしょうか? ご教授ください。 お願いいたします。

  • alato
  • お礼率77% (70/90)

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

  • ベストアンサー
  • izmlz
  • ベストアンサー率55% (67/120)
回答No.3

 ずれてしまうのは、TopとLeftを絶対ポイントで設定しているためだと思います。その理由については↓などをご参考にしてみてください。 別のコンピュータでファイルを開くと画面表示や印刷結果が異なる場合の注意事項 http://support.microsoft.com/kb/881233/ja  従って、keirikaさんご提案のように、絶対ポイントではなくセルの位置にオートシェイプを合わせる方法が私も良いんじゃないかと思います。Top、Leftに加えて、WidthとHeightもセル範囲にあわせるマクロの例は↓です。 Sub test()  Dim Rng As Range  Dim myShape As Shape    Set Rng = Range("I2") '選択した項目によって○を表示させるセルを設定。Range("I2:J4")のようなセル範囲でもOK  Set myShape = ActiveSheet.Shapes("xlBunsyo")    With myShape   .Left = Rng.Left   .Top = Rng.Top   .Width = Rng.Width   .Height = Rng.Height  End With    Set Rng = Nothing  Set myShape = Nothing End Sub  なお、alatoさんのご質問を読んで、私には、実情とその問題の原因、解決策などは上のように、それほど苦労することなく思い浮かびました。(もし、はずしていたら申し訳ありませんが)「質問として無茶」などとは全く思いませんでした。

参考URL:
http://support.microsoft.com/kb/881233/ja
alato
質問者

お礼

早速のご回答ありがとうございます。 今回の原因が究明できました。 画面のプロパティでフォントの大きさが違っておりました。 自分のが小さいフォント96dpi,相手のが大きいフォント120dpiでした。 ご教授いただいた方法でうまくいきました。 ありがとうございました。 最後のフォローもありがとうございました!

その他の回答 (2)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

この質問は実情を十分表現していない。質問として無茶。 全体の流れはどうなっているのか。 どういう風に何をしたいのか。 (1)>選択した項目によって○をつけるコードを書いたのですが 丸はどこに入れるのか。セルか図形の上かその他か。セルでもクリックするとそのセルの位置に丸を出すのか。 セルの画面上の位置は列幅、行高を変えると丸の位置は相対的に変わるぐらい常識だ。 セル位置と○は関連付けるコードは書いているのか。 (2)質問のコードでは丸を描く部分のコードが出てないが。 (3)図形を選択したというイベントを考えているのか、その他か。 (4)>オートシェイプをしてするにあたり ーーー 不都合の原因を考える(読者・回答者に考えてもらう)、指摘することは、非常に高等な、困難な難しいことなんだ。 このつもりで、十分な状況情報を開示しないと出来ませんよ。 質問者はこのことで頭がいっぱいでも、読者にはコードもやりたいことは判らない。読者の状況が読めてない。

alato
質問者

お礼

アドバイスありがとうございます。 自分の知識が乏しいために要領を得た質問ができずに申し訳ありません。 理解していないせいか、どういうふうに質問してよろしいかどうかさえもわかりません。 とりあえず、解決できましたので、今後の質問の参考にさせていただきます。 ありがとうございました。

  • keirika
  • ベストアンサー率42% (279/658)
回答No.1

ActiveSheet.Shapes("xlBunsyo").Select Selection.ShapeRange.Left = Range("I2").Left Selection.ShapeRange.Top = Range("I2").Top ではどうでしょうか。

alato
質問者

お礼

早速のご回答ありがとうございます。 セルの情報を使うのですね! そんな方法があったとは知りませんでした。 勉強になります。 これを参考に作り直させていただきます。

関連するQ&A

  • オートシェイプの位置

    エクセルですが。 セレクトされているオートシェイプを所定の位置に配置するマクロとして、以下は動作するのですが。 Selection.ShapeRange.Left = 250 Selection.ShapeRange.Top = 100 名前ボックスからオートシェイプの名前を aaa に変更し、以下のマクロを実行すると、いずれもエラーになってしまいます。 aaa.ShapeRange.Left = 250 aaa.ShapeRange.Top = 100 aaa.Left = 250 aaa.Top = 100 どこが間違っているのでしょうか?

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

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

  • Excelのマクロを使用してオートシェイプ図形の色を変えたいのです。

    Excelのマクロを使用してオートシェイプ図形の色を変えたいのです。 オートシェイプ図形を50個ならべて、マウスでクリックしてものは色が変わるようにしたいと思います。 マクロ記録をすると以下のようになりました。 Sub Macro1() ActiveSheet.Shapes("AutoShape 1").Select Selection.ShapeRange.Fill.ForeColor.SchemeColor = 45 Selection.ShapeRange.Fill.Visible = msoTrue Selection.ShapeRange.Fill.Solid End Sub このプログラムを50個書くわけにはいかないのですが、プログラムで処理するのに問題点が2つ出てきました。 ・オートシェイプ図形の名前が"AutoShape 1"となっていますが、これを変更したいのですが、書式設定にはありませんでした。変更するにはどうすればよいのでしょう? ・クリックしたオートシェイプ図形がどれであるかを返す関数がないと、どの図形がクリックされたかわからないのですが、これを返す関数はあるのでしょうか? よろしくお願いします。

  • VBAでオートシェイプのグループ化についての質問です。

    VBAでオートシェイプのグループ化についての質問です。 オートシェイプ線(Line)で台形を作成し全てを選択し、グループ化したいと考えています。 また、連続して台形を作成していきたいと考えています。 ?4本線を引く ?グループ化(Aグループ) ?4本線を引く ?グループ化(Aグループ)  ⇒ 連続して作成・・・ Dim st() As Variant Dim ob As Shape Dim MyLine As Shape '線の作成 Set MyLine = ActiveSheet.Shapes.AddLine(startX, startY, widthX, heightY) '線の選択 For Each ob In ActiveSheet.Shapes   ReDim Preserve st(j)   st(j) = ob.name   j = j + 1 Next ob 'グループ化 Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select と上記コードで一つのグループは作成出来たのですが、次に作成すると Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select でエラーになります。 恐らく前のグループ化内の線も選択してしまうのではないかと思っていますが、対処の仕方が解りません。 線の作成方法から選択方法等いろいろ意見が聞きたいと思っています。 アドバイスよろしくお願いいたします。 m(__)m

  • えくせるまくろで。

    お世話になっております。 基礎的な質問かもしれませんが、、 さっきからうまくいってませんです。 セルに入力された値によって変化し、オートシェイプの→の端につなげて→をかきたいんですが、、、 line1 line2はすでにあるものとして、 Sub sample1() ActiveSheet.Shapes("Line 1").Select Selection.ShapeRange.Item("Line 1").Left = 258.75 Selection.ShapeRange.Item("Line 1").Width = 67.5 / 6 * Range("A1") hako1 = ShapeRange.Item("Line 1").Left + 67.5 / 6 * Range("A1") ActiveSheet.Shapes("Line 2").Select Selection.ShapeRange.Item("Line 2").Left = hako1 Selection.ShapeRange.Item("Line 2").Width = 67.5 / 6 * Range("A2") End Sub と、こうしてたんですが、。 オブジェクトが必要です。とアラームがでます。 どうしたらいいか教えてください。

  • Excel VBA シェイプの原型のサイズ取得方法

    VBAでシェイプの縦横比を%指定で変更したく、下記のように書いています ActiveSheet.Shapes("Picture 208").Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.ScaleWidth 2, msoFalse '横2倍の大きさに ところが、ScaleWidthが見ている数値が元の図形のものと違うようです。原因を探すためにシェイプの原型のサイズ(幅や高さの数値)を知りたいのですが、VBAからアクセスできるプロパティやメソッドはあるでしょうか?

  • VBAのGroup化について

    お世話になります。以下のマクロがうまく動きません。 ------------------------------------------------- Dim objShp1 As Shape For Each objShp1 In ActiveSheet.Shapes If objShp1.Name = "Picture 3" Then ActiveSheet.Shapes.Range(Array("A", "B", "Picture 3")).Select Selection.ShapeRange.Group.Select Selection.ShapeRange.ThreeD.RotationX = -180 Selection.ShapeRange.IncrementLeft 0 Selection.ShapeRange.IncrementTop 0 Else ActiveSheet.Shapes.Range(Array("A", "B")).Select Selection.ShapeRange.Group.Select <---------(1) Selection.ShapeRange.ThreeD.RotationX = -180 Selection.ShapeRange.IncrementLeft 0 Selection.ShapeRange.IncrementTop 0 End If Next ------------------------------------------------- このマクロは全体の一部分になりますが、(1)のところでエラーになります。 どこが間違っているのか、さっぱりわかりません。 すみませんが、お助けいただければ幸いです。

  • エクセル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に入力されるデータが1,2,3,4の4種類、AQ11に5,6,7,8,9の5種類などと、ばらばらです。 P11に1が入力されるとN14:N15(結合されています)に円が入り、2が入力されるとN16に円が入る。 Q11に5が入力されるとR13に円が入り、6が入力されるとR14:R15に円が入る・・・・のようにしたいのです。 一生懸命、セルNo.を打ち込んでいたら、 「コンパイルエラー:プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。

  • Excelでグループ化したオートシェイプにテキストを編集するコード

    Excelの四角のオートシェイプで、例えば、「四角1」「四角2」「四角3」という名前のオートシェイプが3つあったとしてテキスト編集で同じ文字列を入れたいとき、 For a = 1 To 3 ActiveSheet.Shapes("四角" & a).Select Selection.Characters.Text = "文字列" Next a とすればできるのですが、「四角1~3」をグループ化し、名前を「四角」としたとき、 ActiveSheet.Shapes("四角").Select Selection.Characters.Text = "文字列" とするとエラーが出てしまいます。グループ化されたオートシェイプのテキスト編集は、一度グループを解除し、それぞれテキスト編集しなければならないのでしょうか? 回答よろしくお願いします。

  • VBAで画像を自動で切り替える方法

    Excelで棚割表を作っています。商品コードを打つとその商品の画像を自動で表示させたいのですが、雑誌を見ながらコードをアレンジしてほぼ完成したのですが、「プロシージャーが大きい」とエラーが出てマクロを実行出来ません。 画像は100個程度あり、先に別のマクロで貼り付けてあります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ファイル As String If Intersect(Target, Range("A4")) Is Nothing Then ActiveSheet.Shapes("画像").Delete ファイル = "C:\保存場所\" & Range("A4").Value & ".jpg" Range("B5").Select ActiveSheet.Pictures.Insert(ファイル).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Top = ActiveCell.Top Selection.ShapeRange.Left = ActiveCell.Left Selection.ShapeRange.Height = 97 Selection.ShapeRange.Width = 52.5 Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.IncrementLeft 1.5 Selection.ShapeRange.IncrementTop 1.5 Selection.Name = "画像" End If (中略) Dim ファイル98 As String If Intersect(Target, Range("U60")) Is Nothing Then Exit Sub ActiveSheet.Shapes("画像98").Delete ファイル98 = "C:\保存場所\" & Range("U60").Value & ".jpg" Range("V61").Select ActiveSheet.Pictures.Insert(ファイル98).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Top = ActiveCell.Top Selection.ShapeRange.Left = ActiveCell.Left Selection.ShapeRange.Height = 97 Selection.ShapeRange.Width = 52.5 Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.IncrementLeft 1.5 Selection.ShapeRange.IncrementTop 1.5 Selection.Name = "画像98" End Sub 省ける箇所や分割する方法などありましたら教えてください。

専門家に質問してみよう