[[20220209144840]]　『画像挿入時のエラーについて』（うさぎ）　ページの最後に飛ぶ

『画像挿入時のエラーについて』（うさぎ）

下記のマクロを使って画像を連続で挿入しています。

1．マクロで画像挿入　→　2．再度マクロで画像を挿入　
という単純な作業であればエラーがでないのですが、
1．マクロで画像挿入　→　2．セルに文字を入力する　→　3．再度マクロで画像挿入
と別の作業を挟むと3で実行されずエラーが出ます。
2．セルに文字を入力する　の後にExcelを保存するとエラーが出ずに実行できます。

一々保存せずに1、2、3を繰り返して作業したいのですが、どうすればよいのかご教授よろしくお願いいたします。

―――――――――――――――――――――――――――――――――――

Sub ShpAdTest()

Dim FNames As Variant, myShp As Shape
Dim Fn As String, i As Long

    FNames = Application.GetOpenFilename( _
         filefilter:="Image(*.jpg;*.gif;*.bmp;*.png),*.jpg;*.gif;*.bmp;*.png", _
         Title:="図の挿入(複数選択可）", _
         MultiSelect:=True)

    If Not IsArray(FNames) Then Exit Sub

    Call BubbleSort_Str(FNames, True, vbTextCompare)

    Application.ScreenUpdating = False

    For i = LBound(FNames) To UBound(FNames)

         PasteShp (FNames(i))

    With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

        .LockAspectRatio = msoTrue
        .Placement = xlMove
        .DrawingObject.PrintObject = True
        .Height = 150
        .Width = 224

    End With

　　　　ActiveCell.Offset(15).Select

 Next

End Sub

Sub PasteShp(fname As Variant)
Dim Shp As Shape

Set Shp = ActiveSheet.Shapes.AddPicture( _
Filename:=fname, _
linktofile:=False, savewithdocument:=True, _
Left:=Selection.Left, Top:=Selection.Top, _
Width:=0, Height:=0)

Shp.ScaleHeight 1!, msoTrue
Shp.ScaleWidth 1!, msoTrue

Set Shp = Nothing

End Sub

Private Sub BubbleSort_Str( _
ByRef Source As Variant, _
Optional ByVal SortAsc As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbTextCompare)

If Not IsArray(Source) Then Exit Sub

Dim i As Long, j As Long
Dim vntTmp As Variant
For i = LBound(Source) To UBound(Source) - 1
For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1
If StrComp(Source(IIf(SortAsc, j, j + 1)), _
Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then
vntTmp = Source(j)
Source(j) = Source(j + 1)
Source(j + 1) = vntTmp
End If
Next j
Next i

End Sub

＜使用 Excel：Office365、使用 OS：Windows10 ＞

エラーは、

実行時エラー 1004 「アプリケーション定義またはオブジェクト定義のエラーです。」

と出ます。

前任者が作成したマクロのため、理解できずデバック？しても何でつまづいているのかわからない状態です。
（うさぎ） 2022/02/09(水) 16:07

元はここですよね。
https://okwave.jp/qa/q9925073.html

前任者ですか？
昨年の9月ごろで…。
（前任者？） 2022/02/09(水) 17:03

前任者の人がそれを参考にして作った？のかもしれませんが・・・

エラーについては教えてもらってないので、質問いたしました。
（うさぎ） 2022/02/09(水) 18:03

 Shapeにはいろいろな種類があります。
 図形、画像、のほか、コメント、入力規則のドロップダウン等です。
 画像以外のものが悪さをしているように想像します。

 そこで、以下の点を確認して教えてください。

 (Q1)下記のプロシージャの結果（イミディエイトウインドウに出力される）を
     教えてください。
 Sub test()
     Dim shp As Shape
     For Each shp In ActiveSheet.Shapes
         Debug.Print shp.Name, shp.Type
     Next
     Debug.Print "------------------------"
 End Sub

 (Q2)現在のコードの一行だけを変更してみてください。
 With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
 を
 With ActiveSheet.Shapes(ActiveSheet.Pictures.Count)
 に変更して、実行結果（エラーの有無）を教えてください。

（γ） 2022/02/09(水) 20:13

 広義のShapeとして、「コメント」と「入力規則」を上げましたが、
 たぶん原因は「入力規則」ではないかと思います。

 ・入力規則を使ったあとで、上記であげたtestを実行すると
   Type=8のShapeが観測されます。
 ・しかし、いったんブック保存を行った直後に再度実行すると
   Type=8のShapeは結果に載ってきません。
   こうなる理由は私には不明ですが、いわゆる仕様ということなんでしょう。
   保存によって、いったん利用可能にした入力規則が閉じられるのでしょうか。
 この観察結果は、
 ＞セルに文字を入力する　の後にExcelを保存するとエラーが出ずに実行できます。
 という現象と整合的です。

 なお、「コメント」は、ブックの保存にかかわらず常に対象と把握されますので、
 上記の現象とは整合しません。

 図形などのShapeがなく、画像（と入力規則）だけであれば、
 ActiveSheet.Shapes(ActiveSheet.Pictures.Count)によって、
 直前で挿入した画像がつかまえられるはずです。
（γ） 2022/02/09(水) 22:05

γさま

回答ありがとうございます。

(Q1)下記のプロシージャの結果（イミディエイトウインドウに出力される）を

     教えてください。

・画像貼り付けていないシートでは------------------とだけでます
・元マクロで3枚画像貼り付け後で試した結果下記が出ました。
　
　Picture 2 13
　Picture 4 13
　Picture 6 13
　Drop Down 1 8
　------------------------

 (Q2)現在のコードの一行だけを変更してみてください。
 With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
 を
 With ActiveSheet.Shapes(ActiveSheet.Pictures.Count)
 に変更して、実行結果（エラーの有無）を教えてください。

＞試してみたところエラーが出なくなりました。
　使用Excelファイルはオートシェイプなどはなく、画像とドロップダウンのみなので
　γさんがおっしゃった通りになりました。
　こんな一つのことで変わるものなのですね。
　改めてお力添えいただきありがとうございます。
（うさぎ） 2022/02/10(木) 09:44

 解決したようで何よりです。

 以下、自分用の備忘も兼ねてメモしておきます。
 （閲覧者さんの参考になれば幸いです。ご返事は不要です）

 Activesheet.Shapes の要素を For each で列挙したときの順序は、
 以下のようになります。
 (1)AotoShape(Type=msoAutoShape)および Picture(Type=msoPicture)のグループ
 (2)コメント(Type=msoComment)のグループ
 (3)入力規則(Type=msoFormControl)のグループ
 また、この順序は、対応する整数インデックスの順序でもあります。

 なお、
 ・(1)のグループのなかでは、AutoShapeとPictureが順不同で混在します。
   ですから、AutoShapeが一つでもあると、今のロジックは破綻します。 
 ・(1)(2)(3)はかならず、この順になるようです。
 ・この順に従うことは、内部のロジックに依存していて、
   その順序を外部からコントロールはできないと思います。

（γ） 2022/02/10(木) 10:46

 普通に考えれば、
 PasteShpで挿入した画像が確定しているのですから、
 その画像オブジェクトをNothingなどとせずに、
 それを使って、
          .LockAspectRatio = msoTrue
         .Placement = xlMove
         .DrawingObject.PrintObject = True
         .Height = 150
         .Width = 224
 の処理を行えばよいだけの話でした。
 ActiveSheet.Shapesの列挙の順序とか、七面倒な議論は余計なことだったかもしれません。
（γ） 2022/02/10(木) 12:05

コメント返信：

[ 一覧(最新更新順) ]

[[20220209144840]] 『画像挿入時のエラーについて』（うさぎ） ページの最後に飛ぶ

[[20220209144840]]　『画像挿入時のエラーについて』（うさぎ）　ページの最後に飛ぶ