Excel Image Viewer and Rename its File Name

[buvanamali]

Dear Experts

I would like to view image in Excel and rename the current file name. In excel I can’t view the file in full size. Please help me to view the image in full size. Also please put an DELETE button to remove the image in the folder.

Attached herewith the fotos folder and the excel file for your kind perusal.

Thanking you in advance.

Yours sincerely
Buvanamali

p.s. I had already posted here. But no response. https://www.excelforum.com/excel-programming-vba-macros/1420223-excel-image-viewer-and-rename-its-file-name.html

[June7]

Should include Option Explicit in every module header. In the VBE > Tools > Options > check "Require Variable Declaration". You will have to type it into existing modules.

Define "full size" and display where in Excel?

A delete procedure should be simple. Use Kill statement https://learn.microsoft.com/en-us/office/vba/Language/Reference/user-interface-help/kill-statement

[buvanamali]

Dear Experts

Option Explicit is included in the module.
The picture is not diplayed in its full size.
Please help me.

Yours sincerely
Buvanamali

[June7]

Option Explicit was not in module of file I downloaded. That's why I mentioned it. I added it and found a variable that had not been declared.

I still don't know what you mean by "full size". Looks big enough to me. If you want to view in an external image app, managing that would be more difficult.

Need to add code that disables/enables Prev/Next buttons when on first or last file.
Also make sure Filelist is cleared before reading in file names from selected folder.

Consider this revised code:

Option Explicit
Dim v_row As Integer
Dim v_filecount As Integer

Sub LoadNextImage()
If v_row < v_filecount Then
LoadImage 1
Else
MsgBox "This is last image"
End If
End Sub

Sub LoadPrevImage()
If v_row > 3 Then
LoadImage -1
Else
MsgBox "This is first image"
End If
End Sub

Sub LoadImage(intDirection)
Sheets("Update").Range("K9").Value = Sheets("Update").Range("K9").Value + intDirection
v_row = Sheets("Update").Range("K9").Value
Sheets("Update").Image1.Picture = LoadPicture(Sheets("Filelist").Range("B1").Value & Sheets("Filelist").Range("B" & v_row).Value)
Sheets("Update").Range("K7").Value = Sheets("Filelist").Range("B" & v_row).Value
End Sub

Function GetImageDirectory() As String
Dim v_imagefolder As FileDialog
Dim v_imageitem As String
Set v_imagefolder = Application.FileDialog(msoFileDialogFolderPicker)
With v_imagefolder
.Title = "Select the Image Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
v_imageitem = .SelectedItems(1)
End With
NextCode:
If Right(v_imageitem, 1) <> "\" Then
v_imageitem = v_imageitem & "\"
End If
GetImageDirectory = v_imageitem
Set v_imagefolder = Nothing
End Function

Sub ListImageFiles()
Dim v_fldrpath As String, v_pth As String, Filename As String
v_fldrpath = GetImageDirectory
Sheets("Filelist").Range("B1").Value = v_fldrpath
v_pth = v_fldrpath
Filename = Dir(v_pth)
Sheets("Filelist").Range("A3:B" & Sheets("Filelist").Cells.SpecialCells(xlCellTypeLastCell).Row).Clear
Do While Filename <> ""
v_filecount = v_filecount + 1
Sheets("Filelist").Range("A" & v_filecount + 2).Value = v_filecount
Sheets("Filelist").Range("B" & v_filecount + 2).Value = Filename
Filename = Dir()
Loop
Sheets("Update").Range("K9").Value = 3
LoadImage 0
End Sub

Sub ChangeName()
Dim oldname As String, newname As String
oldname = Sheets("Filelist").Range("B1").Value & Sheets("Update").Range("K7").Value
newname = Sheets("Filelist").Range("B1").Value & Sheets("Update").Range("K11").Value
Name oldname As newname
v_row = Sheets("Update").Range("K9").Value
Sheets("Filelist").Range("B" & v_row).Value = Sheets("Update").Range("K11").Value
LoadImage 0
End Sub

[buvanamali]

Dear Experts
Thanks for your kind assistance.
I mean that by "full size" ie. the image which we are seeing in XL sheet is not the full image. And it is partially displayed. May be enlarged.

Yours sincerely
Buvanamali

[June7]

Oh, I get it now. I had not looked at image outside Excel. Just change the image control PictureSizeMode property to 3 - frmPictureSizeModeZoom. Resize the control to whatever dimensions you want. I went with 400 Height x 300 Width.

What do you think of revised code so far?

Ooops, found error in my new code - change


If v_row < v_filecount Then

to


If v_row < v_filecount + 2 Then

[buvanamali]

Dear Experts
The display size was now expanded as per my requirement. I am enclosing the file for your kind perusal and for others who follow the thread.
Now I am getting error no.52 " Bad File Name or Number "while renaming the file in other than English.

Thanking you

Yours Sincerely
Buvanamali

[June7]

Provide example of non-English filename that causes error.

[buvanamali]

Dear Experts

I enclose here with the sample file and zip folder containing few .jpg files to be renamed in non-english file name (Tamil). The non-English file name is in C Column of Sample File - Filelist Sheet.

Please Provide me a Solution.

Thanking you

Yours sincerely
Buvanamali

[buvanamali]

Dear Experts

With the following macro I am able to change Non English File Name without any problem. I do not know how to use this macro rename multiple files.
Please help me.


ChangeFileName(sFile, tFile)
On Local Error GoTo errors
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
fs.MoveFile sFile, tFile
Set f = Nothing
Exit Sub
errors:
MsgBox "File: " & sFile & vbCrLf & Err.Description
Err.Clear
End Sub

Sub test()
Const sDir = "C:\Users\TOSHIBA\Desktop\Fotos\"
ChangeFileName sDir & Range("B3").Value, sDir & Range("C3").Value
End Sub


Also the above code doesn't save the file name as "*.jpg"
Thanking you

Yours sincerely
Buvanamali

[June7]

You want user to enter a value into textbox and use that to change name? Replace code in the ChangeName procedure.

None of the new names have .jpg extension. Need to make sure the same extension as original is used. Assuming users will not type file extension.


Sub ChangeName()
Dim fs As FileSystemObject, ext As String, oldName As String, newName As String, sDir As String

sDir = Sheets("Filelist").Range("B1").Value
oldName = sDir & Sheets("Update").Range("K7").Value
newName = Sheets("Update").Range("K11").Value
ext = Mid(oldName, InStrRev(oldName, "."))

Set fs = CreateObject("Scripting.FileSystemObject")
fs.MoveFile oldName, sDir & newName & ext

Sheets("Filelist").Range("B" & v_row).Value = newName & ext
LoadImage 0

End Sub

However, I am now having issue with loading images with this new name.

It works if changing to English name. Sorry, I don't have a solution.

[buvanamali]

Dear Experts

The same error as posted in post#7. Please advise.

Yours sincerely
Buvanamali

[June7]

I know it has same error with non-English name. File name is changed and then code cannot load image.

I have no solution for this.

[buvanamali]

Dear Experts

With the following macro I am able to change Non English File Name without any problem. I do not know how to use this macro rename multiple files.
Please help me.


ChangeFileName(sFile, tFile)
On Local Error GoTo errors
Dim fs, f, s
Set fs = CreateObject("Scripting.FileSystemObject")
fs.MoveFile sFile, tFile
Set f = Nothing
Exit Sub
errors:
MsgBox "File: " & sFile & vbCrLf & Err.Description
Err.Clear
End Sub

Sub test()
Const sDir = "C:\Users\TOSHIBA\Desktop\Fotos\"
ChangeFileName sDir & Range("B3").Value, sDir & Range("C3").Value
End Sub


Also the above code doesn't save the file name as "*.jpg"
Thanking you

Yours sincerely
Buvanamali

The above Code changes non english names only for single row. I wanted to rename multiple files. please try to help me.

[June7]

Can loop through a list of files. So if you have old name and new name in two columns of worksheet as in your current version of workbook, like:


Sub test()
Const sDir = "C:\Users\TOSHIBA\Desktop\Fotos\"
Dim x As Integer, rows As Integer, ext As String, strName As String
rows = Sheets("Filelist").Cells.SpecialCells(xlCellTypeLastCell).Row
For x = 3 To rows
strName = Sheets("FileList").Range("B" & x).Value
ext = Mid(strName, InStrRev(strName, "."))
If Not IsEmpty(Sheets("Filelist").Range("C" & x).Value) Then
ChangeFileName sDir & strName, sDir & Sheets("Filelist").Range("C" & x).Value & ext
End If
Next
End Sub

[buvanamali]

Dear Experts

It is working as desired. Now I request for 3 more requirements.
1) The value whatever I type in K11 shall be appended to (Filelist) sheet "C" Column.
2) If the file name repeated in Col C then Filename 1 , Filename 2 , File Name 3 likewise renamed
3) If I put delete in C Col, while renaming the files, delete row should delete images in the folder.

Thanking you for your efforts.

[Aussiebear]

@buvanamali, please start a new thread. Your initial issue has been solved as you have indicated.

[buvanamali]

Dear Experts

I marked the thread is solved.

I started a new thread for rest of my requirements.

Thanking you

Yours sincerely
Buvanamali