• 締切済み

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

  • wbx
  • お礼率100% (1/1)

みんなの回答

回答No.1

私は、Word2007以降を未だに使ったことがないので、回答を しないでおこうと思ったのですが、他の回答が付かないみたい なので、簡単なアドバイスだけをしますね。 Word2007以降は、オートシェイプと画像などの図との関係が 少し変わってきていますので、マクロ記録を取った場合でも、 一部違う項目が追加されていることがあります。 今回の場合も、もしかしたらWord2007にて追加されたものが 影響しているのかもしれませんね。 http://msdn.microsoft.com/en-us/library/bb257205(v=office.12).aspx http://msdn.microsoft.com/en-us/library/bb257749(v=office.12).aspx 私が回答をした過去ログですが、質問者の補足にある内容が 少しは参考になるかもしれませんね。(No.4の回答への補足) http://okwave.jp/qa/q6834777.html

wbx
質問者

お礼

ありがとうございます。 教えていただいたページを見たのですが、.Heightプロパティ自体は「Returns or sets the height of the specified shape range. Read/write Single.」とのことでそのまま残っているようです。 エラーの内容から.Heightの取得に失敗してそうなんですが、それが2007の影響なのかなと思います。 (.HeightRelativeがアヤシイ?) 私も手元に2007がないもので、試行錯誤が出来ず未だ解決しておりません…

wbx
質問者

補足

自己解決しました。 あれからやっと2010を入手したので見てみたところ、使っていた方のWordで2003では画像を貼りつけた時の既定値を「前面」にしていたところを、2007ではその設定をせずに、「行内」にして使っていたためと判明しました…。バージョンの違いではなかったようです。お騒がせしました。 またそれとは別な問題なのですが、 「clp = ActiveDocument.Shapes.Count 'すべてのshapeを数える Set MyShape = ActiveDocument.Shapes(clp) '最後にペーストしたshape」 の部分がうまく働かなくなっていました。2003では図を貼り付けるとそれにshapesの中で一番新しい数字が振られていたのですが、2010ではそうとは限らないようで、別の図が動いてしまう事態に陥りました。こちらの原因がバージョンによるものかどうかわかりませんが、今までの図には名前をつけて区別してから貼り付けることで解決しました。

関連するQ&A

  • Excel マクロのエラーを直したいです。

    いつもお世話になっております。 さて、下記マクロを作成(コピー&ペースト)したのですが、矢印以外のあみかけ、罫線などがセルに表示されてしまいます。 どのように修正すれば、矢印だけが表示されるようになるのでしょうか? 修正頂ければ、幸甚です。宜しくお願い致します。 ※マクロ初心者です。 (1)Sub 外部デイ利用() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2.5) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF, TP, LF + WD, TP).Select Selection.ShapeRange.Line.Weight = 1# Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub (2)Sub 認知デイ利用() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2.5) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF + 6, TP, LF + WD, TP).Select Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadOval Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub

  • WORDマクロエラー

    Wordでテキストボックスをレイアウト枠に変換するマクロを作りました。 簡単なコードだと思うのですが、「オブジェクト変数またはブロック変数が設定されていません」というエラーが出てしまいます。 どこに原因があるのでしょうか? Sub テキストボックス変換() Dim i Dim sp As Shape For i = 1 To ActiveDocument.Shapes.Count If sp.Type = msoTextBox Then sp.ConvertToFrame End If Next End Sub

  • ワード2002で「 Selection.ShapeRange.Left 」 が設定できない

    こんにちは。 OSはWinXP Pro、OfficeXPを使用しています。 1ページ目にあるグループ化された図形をページを 追加して貼り付けていくマクロを以前質問したので すが、ShapeRange.Leftの代入がうまくいきません。 ******************************************** Sub 図形追加() Dim siTop As Single Dim siLeft As Single Selection.HomeKey unit:=wdStory ActiveDocument.Shapes("Group 1478").Select siTop = Selection.ShapeRange.Top siLeft = Selection.ShapeRange.Left Selection.Copy Selection.EndKey unit:=wdStory Selection.InsertBreak Type:=wdPageBreak Selection.GoTo What:=wdGoToPage, _ Which:=wdGoToNext Selection.Paste Selection.ShapeRange.Top = siTop Selection.ShapeRange.Left = siLeft Selection.HomeKey unit:=wdLine End Sub ******************************************** 上述の値を追っていくと、 siTop=40.25、siLeft=46が入っているのですが、 下から2段目のShaperange.Leftを実行すると そこには-785.05 という数値が入ってしまいます。 (どこからその数値がでてきたのか????) Shaperange.Topはうまくいくのですが、ステートメント の実行順を変えてもうまくいきません。 どなたか解決策のご教授をお願いします。

  • Word2010 VBAでオブジェクトに文字の効果

    Word2010のVBAで作成するオートシェイプに文字を入力し、その文字に文字の効果を付けたいです。 付けたい効果は「ワードアートのスタイル」の「文字の効果」内にある「変形」の「四角」です。 Sub 図形() Dim 丸 As Shape Set 丸 = ActiveDocument.Shapes.AddShape(msoShapeOval, 1, 1, 60, 60) 丸.Select 丸.TextFrame.TextRange = "文字" 'この部分です。Excelではこれで出来たのですがWordだと書き方が違うのでしょうか? Selection.ShapeRange.TextEffect.PresetShape = msoTextEffectShapePlainText End Sub よろしくお願いいたします。

  • 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)のところでエラーになります。 どこが間違っているのか、さっぱりわかりません。 すみませんが、お助けいただければ幸いです。

  • 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されないのだと思われます よろしくお願いします

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

  • エクセルVBAでオートシェープを識別して削除したいのです・・・

    エクセルシートにたくさん貼り付けた画像を一度に削除するため、下記のようなマクロを作成しました。 しかし、これでは「テキストボックス」や「→」のようなオートシェープも全部消えてしまいます。 画像データ(図)だけを認識して消すにはどうすればよいのでしょうか? Sub sakujo() Dim Myshape As Shape For Each Myshape In ActiveSheet.Shapes If Myshape.Type <> msoFormControl Then Myshape.Delete End If Next End Sub

  • 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

  • Excelの罫線に関するマクロ

    Excelの罫線に関するマクロ 罫線を引き、それを赤くするマクロを作ったのですが、赤罫線の下にもうひとつ罫線が表示されてしまいます。どこを削除すればよいのでしょうか。 ご教示お願いいたします。 Sub 罫線() Dim T1 As Single, L1 As Single Dim T2 As Single, L2 As Single Dim myShp As Shape With Range("c15") T1 = .Top L1 = .Left End With With Range("d14") T2 = .Offset(1, 1).Top L2 = .Offset(1, 1).Left End With Set myShp = ActiveSheet.Shapes.AddLine(L1, T1, L2, T2) ActiveSheet.Shapes.AddLine(L1, T1, L2, T2).Select With Selection.ShapeRange.Line .Visible = msoTrue .Style = msoLineSolid .Weight = 5# .ForeColor.SchemeColor = 10 End With End Sub よろしくお願いします。

専門家に質問してみよう