[[20181107234449]]　『JPGの画像の名前変更』（狭山）　ページの最後に飛ぶ

『JPGの画像の名前変更』（狭山）

 お世話になります。
 お聞きしたい事がありまして投稿致しました。

 フォルダー名『処理画像』があります。
 エクセル名『画像名変更』でシート名『画像取り込みを変換』というシートだあります。
 このシートからB列に画像を取り込み(画像の大きさは証明証の写真位)
 C列には現在の画像の名前 D列には変更する名前を入れて
 VBAを実行しますとフォルダー名『処理画像』の画像の名前が全て変更される
 という事は可能なのでしょうか。
 因みに画像の枚数ですが640 × 480 が400～500枚程度入っています。

 画像を取り込み理由は、写真を見ながらD列に入力されている
 名前と合っているか照合するためです。

 ご教授をお願い致します。

＜使用 Excel：Excel2013、使用 OS：Windows7 ＞

う～ん。質問がピンとこないけど
(1)マクロでファイル名を変えることができますか　→　はい
http://officetanaka.net/excel/vba/tips/tips91.htm#rename

(2)マクロで画像をシート（セル）に貼り付けることはできますか　→　はい
https://www.moug.net/tech/exvba/0120020.html

(3)自分で作るのめんどくさいので作ってもらえませんか　→　私はいいえ

たぶん、（１）と（２）は分けて考えたほうがいいようにおもいますし、一旦は自分で取り組んでみて、どこがどううまくいかないのかを提示して添削を求めたほうが答えが付きやすいんじゃないかな～とおもいます。
（もこな２） 2018/11/08(木) 06:43

 現在印刷する写真！選ぶのに使っています　＾＾　。。。回答ではありませんが
制作の一助にでもなれば幸甚です。
file名変更は下記サイトが参考になるかと。
http://officetanaka.net/excel/vba/tips/tips91.htm

 自分しか使わないので雑な仕様になっております。
バックアップ必須で。。。いろいろ変更して遊んでみてください。
でわ　m(_ _)m

 Option Explicit
Sub main()
    Const Opath As String = "処理画像"
    Dim Fnm, y&, x&, buf, mypath$
    With Worksheets("画像取り込みを変換")
        .UsedRange.Clear
        Call mysp_del(Worksheets("画像取り込みを変換"))
        y = 2: x = 1
        mypath = ThisWorkbook.Path & "\" & Opath & "\"
        Fnm = Dir(mypath & "*.jp*")
        Do While Fnm <> ""
            Set buf = .Shapes.AddPicture(mypath & Fnm, False, True, _
                      .Range(.Cells(y, x), .Cells(y + 6, x + 2)).Left, _
                      .Range(.Cells(y, x), .Cells(y + 6, x + 2)).Top, _
                      .Range(.Cells(y, x), .Cells(y + 6, x + 2)).Width, _
                      .Range(.Cells(y, x), .Cells(y + 6, x + 2)).Height)
            .Cells(y, x).Offset(-1) = Fnm
            DoEvents
            Fnm = Dir()
            x = x + 4
            If x > 24 Then
                x = 1: y = y + 8
            End If
        Loop
    End With
End Sub
Private Sub mysp_del(ByVal ws As Worksheet)
    Dim sp As Object
    For Each sp In ws.Shapes
        sp.Delete
    Next
 End Sub

（隠居じーさん） 2018/11/08(木) 08:02

 確認ですが、
 すでに写真はB列上に貼り付けてあって、C列・D列も記入済みの状態で
 マクロ実行によりフォルダ『処理画像』内のC列の同じファイル名のものを
 D列に書いているファイル名に変える、
 っていうことですよね？
（ろっくん） 2018/11/08(木) 08:51

（もこな２）様（隠居じーさん）様

 参考のサイトまで有難うございました。
 （隠居じーさん） 様のVBAですが今回の行いたい事とは違いましたが
 制作の一助にでもなれば幸甚です。
 この気持ち、本当にうれしいです。

 （ろっくん）様のご質問の件ですが
　シートは空の状態で
 マクロ実行によりフォルダ『処理画像』をB列に取り込み
 C列には現在のJPGの名前も写真の横に書き出し
 D列には変更したい名前を入力して再びマクロを実行すると
 フォルダ『処理画像』の中に入っている画像全ての名前がD列で変更した名前になっている
 という感じなのですが
 説明不足で申し訳ございません。

（狭山） 2018/11/08(木) 11:05

 こんな感じでしょうか。
 どういう風に運用されるかよくわかりませんのでモジュールレベルの変数は使ってません。
 また、1行目は見出しとして考えています。

 下記は画像を取得します。（パスは任意で変更してください）
 貼り付け位置はB列で、セルの大きさに合わせています。

 Sub GetPicture()
    Const PictFolderPath As String = "D:\処理画像"
    Dim Sh          As Worksheet
    Dim FSO         As Object
    Dim PictFile    As Object
    Dim Rng         As Range
    Set Sh = Sheets("画像取り込みを変換")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each PictFile In FSO.GetFolder(PictFolderPath).Files
        If LCase(FSO.GetExtensionName(PictFile)) = "jpg" Or LCase(FSO.GetExtensionName(PictFile)) = "jpeg" Then
            Set Rng = Sh.Range("C" & Sh.Rows.Count).End(xlUp).Offset(1, -1)
            Sh.Shapes.AddPicture PictFile, msoTrue, msoTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height
            Rng.Offset(, 1).Value = PictFile.Name
        End If
    Next PictFile
    Set FSO = Nothing
 End Sub

 下記がファイル名変更用のコードです。
 拡張子はD列に書き入れる必要はありません。
 エラー処理等はしておりません。

 Sub FileNameChange()
    Const PictFolderPath As String = "D:\処理画像"
    Dim Sh          As Worksheet
    Dim FSO         As Object
    Dim PictFileN    As String
    Dim i           As Long
    Set Sh = Sheets("画像取り込みを変換")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For i = 2 To Sh.Range("C" & Sh.Rows.Count).End(xlUp).Row
        PictFileN = PictFolderPath & "\" & Sh.Range("C" & i).Value
        If FSO.FileExists(PictFileN) Then
            FSO.GetFile(PictFileN).Name = Sh.Range("D" & i).Value & "." & FSO.GetExtensionName(PictFileN)
        End If
    Next i
    Set FSO = Nothing
 End Sub
（ろっくん） 2018/11/08(木) 11:54

（ろっくん）様

 ありがとうございます。
 早速にコードを入れ実行しましたら以下の部分にエラーが出てしまいました。
 申し訳ございませんが、ご教授をお願いいたします。

　For Each PictFile In FSO.GetFolder(PictFolderPath).Files
（狭山） 2018/11/08(木) 15:07

 どんなエラーメッセージが出ましたか？

 もし「パスが見つかりません」というエラーでしたら
 Const PictFolderPath As String = "D:\処理画像"
 のダブルクォーテーション内のパスを正しいものに変えてください。
 （実際にJPG画像の入っているフォルダのフルパス）
（ろっくん） 2018/11/08(木) 15:39

　（ろっくん）様
　早速のご返信ありがとうございました。

 ご指示のとおり"D:\処理画像"の部分を変更しましたら
 出来ました。
 本当に素晴らしいと実感しました。
 今後とも、よろしくお願いいたします。
（狭山） 2018/11/08(木) 16:20

コメント返信：

[ 一覧(最新更新順) ]

[[20181107234449]] 『JPGの画像の名前変更』（狭山） ページの最後に飛ぶ

[[20181107234449]]　『JPGの画像の名前変更』（狭山）　ページの最後に飛ぶ