マクロ教えてください

マクロ初心者です。
下記のコードはグーグルで検索してｺｰﾄﾞの継ぎ接ぎで作成しています。

処理内容は
【sub 画像 の処理について】
1、指定フォルダからフォルダ内の画像をすべて開く。
2、開いた画像名をセル「ax1」～順番に記入
3、画像は適当なところに貼り付ける

【sub 名前変更の処理について】
1、アクティブシートの画像をすべてに名前の変更を１からナンバリングする。



上記のような処理を行いたいのですが、
【画像】マクロを実行し【名前変更】の処理をすると
エクセル画面の「名前ボックス」セル番号とか表示される内容は
画像保存名のままでナンバリングできません。
オブジェクトだからなのでしょうか？
説明不足で恐縮ですがアドバイスをお願いします。

Sub 画像()
Dim strFileName As String, dirPath As String
Dim Obj As Object

Range("Ax1").Activate

dirPath = "C:\Users\画像\"
strFileName = Dir(dirPath & "*.JPG")

Do Until strFileName = ""
ActiveSheet.Pictures.Insert(dirPath & strFileName).Select


ActiveCell.Value = strFileName
ActiveCell.Offset(1, 0).Activate

strFileName = Dir()
Loop



End Sub




----------------------------------------------
Sub 名前変更()
Const conName As String = ""
Dim c As Long
Dim objShape As Object
For Each objShape In ActiveSheet.Shapes
If objShape.Type = msoPicture Then
c = c + 1
objShape.Name = conName & c
End If
Next
End Sub

質問者からの補足コメント

• 早速の回答ありがとうございます。
  
  ＞画像保存名のままでナンバリングできません。オブジェクトだからなのでしょうか？
  If objShape.Type = msoPicture Then　は、画像ならとなっていますが、貼り付けたjpgは画像（13）と確定していますか？
  →マクロ起動後の画像は「図13」のように確定しています
  
  ＞ActiveSheet.Pictures.Insert(dirPath & strFileName).Select　リンク画像　（11）になっているのではないでしょうか？
  →回答を頂いたように、パス名と画像ファイルをしているのでリンク画像という扱いになります。
  
  「挿入タブ」から「画像」を複数選択するような通常動作である場合、
  最初の質問のマクロ「名前変更」が実行され
  開いた順番に1から10にナンバーリングされます
  のようにしたいです。説明不足で申し訳ありません。

  No.1の回答に寄せられた補足コメントです。 補足日時：2020/08/26 15:11

No.2 ベストアンサー 回答者： Qchan1962 回答日時： 2020/08/26 15:38

>→回答を頂いたように、パス名と画像ファイルをしているのでリンク画像という扱いになります。

であれば、

If objShape.Type = msoPicture Then

は、
If objShape.Type = msoLinkedPicture Then
となります。

msoPictureは、画像です。
msoLinkedPictureは、リンク画像です。
つまり、リンク画像の場合、If objShape.Type = msoPicture Then　はFalseとなり
c = c + 1
objShape.Name = conName & c
が実行されません。

ちなみに、画像を挿入時に名前を変える場合と後から変える場合では
実際の処理結果に違いが出ます。

すでに、名前が存在した場合は、どうするかとか、、、

後からなら、既存のシェイプも条件を通れば、リネームされることになります。
このあたりの仕様を検討してプロセスを考えると良いかと思います。

ちなみに、後からシートにある画像に対してリネームを行うなら
同じモジュールにある場合。

Loop
Call 名前変更
End Sub
でOKかと、、


また、挿入時なら

　　Const conName As String = ""
　　Dim c As Long
　　Range("Ax1").Activate

　　strFileName = Dir(dirPath & "*.JPG")

　　Do Until strFileName = ""
　　　　ActiveSheet.Pictures.Insert(dirPath & strFileName).Select
　　　　c = c + 1
　　　　Selection.Name = conName & c　　’ここでリネーム
　　　　ActiveCell.Value = strFileName
　　　　ActiveCell.Offset(1, 0).Activate
　　　　strFileName = Dir()
　　Loop

エラー対策が必要になるかと、、、

ファイルを選択して、、、ならファイルピッカー　FileOpenPicker
フォルダ内すべてなら、、、フォルダピッカーを　FolderPicker　を使うと良いでしょう。

No.3 回答者： Qchan1962 回答日時： 2020/08/26 15:43

投稿して気が付きました。

13などの番号が間際らしかったのですね。
Shapeの種別に関する参考サイトです。

https://www.relief.jp/docs/excel-vba-list-msosha …

No.1 回答者： Qchan1962 回答日時： 2020/08/26 14:05

こんにちは、

＞画像保存名のままでナンバリングできません。オブジェクトだからなのでしょうか？
If objShape.Type = msoPicture Then　は、画像ならとなっていますが、貼り付けたjpgは画像（13）と確定していますか？
＞ActiveSheet.Pictures.Insert(dirPath & strFileName).Select　リンク画像　（11）になっているのではないでしょうか？

リンク貼り付けが問題になる場合は、貼り付け方を検討する必要があると思います。
このまま、リネームするのであれば、Typeを確認してみてはいかがでしょう。

Const conName As String = ""
Dim c As Long
Dim objShape As Object
For Each objShape In ActiveSheet.Shapes

Debug.Print objShape.Type　　’を追加してイミディエイトウィンドウで確認（msoPictureは13です。）

If objShape.Type = msoPicture Then
c = c + 1
objShape.Name = conName & c
End If
Next

この回答へのお礼

Qchan1962さん丁寧な回答ありがとうございます。


無事に自分のしたいマクロを組むことに成功しました。

説明不足なところが多くお手数をお掛けしました。

また近いうち質問することがあると思うので、
その際はまたよろしくお願い致します。

お礼日時：2020/08/26 16:25