• ベストアンサー
  • 困ってます

Word2003でオートシェイプ高さを3mm程度に

Word2003 SP3で、オートシェイプを選択し、 Alt+ドラッグ操作で高さを小さくしていっても4.85mmで頭打ちになり それ以上小さくできません。 ・同じ操作で幅は、3.18mmまでは小さくできます。 ・オートシェイプの書式設定ダイアログで値を直接指定すれば もっと小さくできますが、毎回そんな手間が掛かっては話になりません。 (それで高さを3mmにしても、その後ドラッグで幅調節しようとすると、  高さが4.85mmに押し戻されてしまう) ・同じ環境でも書類によっては、3.18mmまで小さくできます。 ・シェイプ内のテキスト有無や線の太さは関係ないようです。 ●書類によって4.85mmで頭打ちになる現象を解決できないでしょうか? 妥協策として、以下のようなマクロを組んで、ショートカットキーに 割り当て、平易に高さ調節できるようにしてみたのですが、 描画キャンバス内にあるオートシェイプを選んで操作した時に 描画キャンバス全体が(操作対象となって)小さくなってしまいます。 ●描画キャンバス内で選択したオートシェイプのみを対象に  操作が適用されるようにする方法はないものでしょうか? Sub オートシェイプ高さを小さくする() If Selection.Type <> wdSelectionShape Then End Selection.ShapeRange.Height = Selection.ShapeRange.Height - 1 End Sub

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数244
  • ありがとう数2

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

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

> Alt+ドラッグ操作で高さを小さくしていっても > それ以上小さくできません。 [描画オブジェクトをグリッド線に合わせる]ようにしている ためにグリッド線より狭くできないだけですね。 [ページ設定]→[文字数と行数]タブにある[グリッド線]ボタン →[描画オブジェクトをグリッド線に合わせる]にチェックして あるのをはずす。 [図形描画]ツールバー→[図形の調整]→[グリッド]からでも、 同じ[グリッド線]ダイアログを出せます。 [ Alt ]キー+ドラッグ操作をしていることから、上記説明 のチェック項目にチェックがついている状態で作業している ことが判断できます。このチェックをはずせばグリッド線に 関係なく縮小・拡大が自由にできます。 このチェックを入れたままにしておきたいのなら、希望する サイズに[グリッド線の設定]の間隔を指定してください。 直接[ 3 mm ]と入れておけば最小が3 mmになり、その間隔で 合わせることもできます。 描画キャンバスのマクロについては回答できるだけのスキル を持ち合わせていませんので、アドバイスしません。 参考程度なら CanvasItems プロパティなどを使うことで、 設定できるみたいですが、保証はしません。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

詳細に回答いただき、真にありがとうございます。 初歩的な問題だったので、ちょっと頭を垂れました。 ネット上で似たような質問が未解決のままだったので このQAが参考になるところがあれば幸いです。 マクロの方は自力でやるには根本的に勉強が要りそうです。 この場で解決できたら、もちろん助かるので、 もう少し様子を見てから、クローズさせたいと思います。

関連するQ&A

  • オートシェイプの幅を操作するには?

    コマンドボタンにマクロを登録して、オートシェイプの幅を操作したいのですが、 とあるHPから Sub WIDTH_ADD() Selection.ShapeRange.Width = Selection.ShapeRange.Width + 1 End Sub というマクロを見付けました。 ただ、これでは1ずつしか広がりません。 決まったセルに入れた数字分、増加させるにはどのようにしたらよいのでしょうか? 例えば セルA1に10と入力すれば、10増えると言う具合にです。 もしくは、増減させるのではなく幅にあたる数値をセルに入力することによって 幅を自由に変更する方法はありませんでしょうか? 良い方法がありましたらお願いします。

  • 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"となっていますが、これを変更したいのですが、書式設定にはありませんでした。変更するにはどうすればよいのでしょう? ・クリックしたオートシェイプ図形がどれであるかを返す関数がないと、どの図形がクリックされたかわからないのですが、これを返す関数はあるのでしょうか? よろしくお願いします。

  • word2003のマクロが2007でエラーになる

    word2003(windows2000)で使っていたマクロを、人に頼まれてその人の2007のword(windowsXP)に入れたのですがエラーが出て動かないそうです。 マクロは以下のページにあったものの改造で、どこを直したらよいのかわかりません。 http://okwave.jp/qa/q2344318.html 答えでなく、ヒントでも良いのでどなたか教えてください。 h = Selection.ShapeRange.Heightという行で、「エラー5 プロシージャの呼び出し、または引数が不正です」というようなエラーが出るそうです。 2003ではエラーは出ず、選択されている画像の高さがhに入ります。 よろしくお願いします。 ----------------------------------- Public Sub ChgPest() '選択した画像をクリップボードの中身と入れ替えてemfで貼り付ける Dim T, L, h, W, cl, cr, ct, cb As Integer Dim FName As String Dim MyShape As Shape Dim fd As FileDialog Dim clp As Integer Application.ScreenUpdating = False T = Selection.ShapeRange.Top L = Selection.ShapeRange.Left h = Selection.ShapeRange.Height ←●デバッグするとここが黄色になっている W = Selection.ShapeRange.Width posi = Selection.ShapeRange.RelativeVerticalPosition cl = Selection.ShapeRange.PictureFormat.CropLeft cr = Selection.ShapeRange.PictureFormat.CropRight ct = Selection.ShapeRange.PictureFormat.CropTop cb = Selection.ShapeRange.PictureFormat.CropBottom Set myrange = Selection.Range Selection.Delete Selection.PasteSpecial datatype:=wdPasteEnhancedMetafile 'EMFでペースト clp = ActiveDocument.Shapes.Count 'すべてのshapeを数える Set MyShape = ActiveDocument.Shapes(clp) '最後にペーストしたshape ActiveDocument.Shapes(clp).LockAnchor = False 'アンカーを固定しない ActiveDocument.Shapes(clp).WrapFormat.Type = 3 MyShape.Select With Selection.ShapeRange.PictureFormat .CropLeft = cl .CropRight = cr .CropTop = ct .CropBottom = cb End With Selection.ShapeRange.RelativeVerticalPosition = posi Selection.ShapeRange.Top = T Selection.ShapeRange.Left = L Selection.ShapeRange.Height = h Selection.ShapeRange.Width = W Selection.ShapeRange.ZOrder msoSendToBack Application.ScreenUpdating = True End Sub

  • word VBA 文字列操作について

    WORD2007にて、文書内にいくつかの描画キャンバスがあり、この中にいくつかのオートシェイプがあります。(グループ化されたものも含む) マクロにてこのオートシェイプ内の文字列をすべて特定のフォントに変更したいのですが、どなたかCODEを教えて頂けないでしょうか? On Error Resume Next Dim shp As Shape For Each shp In ActiveDocument.Content.ShapeRange shp.Select Selection.Font.Name = "RFPイワタ中太教科書体" Selection.Font.NameAscii = "RFPイワタ中太教科書体" Next shp というものも他のサイトで見つけたのですが、おそらくオートシェイプが描画キャンバス内にあるためにSelectされないのだと思われます よろしくお願いします

  • Word2007マクロ

    宜しくお願い致します Word2007でこんな事が出来ますか Excel2007で線路を作るマクロを作成しました(本を見て) これをWordでも使用したいのですが、Excelのマクロそのまま WordのVisual Basicに書き込んでもエラーが出て機能しません Excelのマクロは以下です Sub 線路作成() 上端位置 = Selection.Top 左端位置 = Selection.Left  Selection.ShapeRange.Line.Weight = 6# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Duplicate.Select Selection.ShapeRange.IncrementLeft -18# Selection.ShapeRange.IncrementTop 9.6 Selection.ShapeRange.Line.DashStyle = msoLineDash Selection.ShapeRange.Line.Weight = 4.5 Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.ForeColor.SchemeColor = 9 Selection.ShapeRange.Line.Visible = msoTrue Selection.Top = 上端位置 Selection.Left = 左端位置 End Sub Wordで使えるようにするには、どこを直せばよいでしょうか。

  • エクセルVBAでオートシェイプの属性を取得する方法を教えてください。

    お世話になります。VBAについてほとんど理解していないので、ピントはずれな質問かも知れませんがよろしくお願いします。 エクセルのシートに四角形のオートシェイプが10個ほどあります。このなかの、1つを選択して色やパターンなどの属性を取得するのに次のように書いてみました。 Sub test() MsgBox Selection.ShapeRange.Fill.ForeColor.SchemeColor MsgBox Selection.ShapeRange.Fill.Patterned End Sub 1行目の色についてはメッセージボックスに表示されるのですが、パターンが表示されません。 パターンの属性を取得する方法を教えてください。 エクセルのバージョンは:EXCEL2002です。 よろしくお願いします。

  • 図形 Selectionが省略できない VBA

    「タイトル」という名の図形はシート上に存在するのですが、 Sub a() ActiveSheet.Shapes.Range(Array("タイトル")).ShapeRange.Height = 110 End Sub Sub b() ActiveSheet.Shapes.Range(Array("タイトル")).Select Selection.ShapeRange.Height = 110 End Sub aだとエラーになりますが、 bだと正常に動きます。 SelectやSelectionは省略できるものだと思ってるのですが なぜaだとエラーになるのでしょうか? 一度図形をアクティブにする動作が必要なのですか?

  • エクセル2007のマクロで画像挿入がうまくいきません。

    エクセル2007のマクロで画像挿入がうまくいきません。 写真のサイズ縦横比がセルにあっていないので伸びてしまいます。 下記のプログラムでサイズ変更も可能でしょうか? フォームのボタンの上に張り付けた場合、ボタンを隠す事は 出来ますか? ボタンの色は変更できるのでしょうか? いろいろわがままな質問で申し訳ありません。 マクロ初心者です。 Sub Pic_in2007() fname = Application.GetOpenFilename ActiveSheet.Pictures.Insert(fname).Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = range("B5:C6").height Selection.ShapeRange.Width = range("B5:C6").width Selection.ShapeRange.left = range("B5:C6").left Selection.ShapeRange.top = range("B5:C6").top End Sub

  • エクセルVBAのWith~End With構文

    Win2000エクセル2000です。 下記のMacro11はTEST11のようにWith~End Withでくくれると思うのですがエラーになります。 どこがおかしいのでしょうか? Sub Macro11() ActiveSheet.Shapes.AddShape(msoShapeSun, 450, 150, 120, 120).Select Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.ForeColor.SchemeColor = 64 Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10 Selection.ShapeRange.Fill.OneColorGradient msoGradientFromCorner, 1, 0.59 Selection.ShapeRange.Adjustments.Item(1) = 0.3016 Selection.ShapeRange.ThreeD.SetThreeDFormat msoThreeD7 Selection.ShapeRange.ThreeD.PresetMaterial = msoMaterialMetal Selection.ShapeRange.ThreeD.Depth = 144# End Sub Sub TEST11() With ActiveSheet.Shapes.AddShape(msoShapeSun, 450, 150, 120, 120) .ShapeRange.Line.Weight = 0.75 .ShapeRange.Line.ForeColor.SchemeColor = 64 .ShapeRange.Fill.ForeColor.SchemeColor = 10 .ShapeRange.Fill.OneColorGradient msoGradientFromCorner, 1, 0.59 .ShapeRange.Adjustments.Item(1) = 0.3016 .ShapeRange.ThreeD.SetThreeDFormat msoThreeD7 .ShapeRange.ThreeD.PresetMaterial = msoMaterialMetal .ShapeRange.ThreeD.Depth = 144# End With End Sub

  • 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 省ける箇所や分割する方法などありましたら教えてください。