Previous Topic Next Topic

Extracting images from a database but named with a specific cell content.

Closed
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019 - Nov 29, 2019 at 09:35 AM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Dec 10, 2019 at 11:50 AM
Hi there people!

I could use some help...

I'm currently importing product images from a database into Excel using the Visual Basic code below:

Sub URLPictureInsert()
'Updateby Extendoffice 20161116
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("A1:A500")
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
.Width = 100
.Height = 100
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("A1").Select
Next
Application.ScreenUpdating = True
End Sub

It works fine the only problem is I have to download 100's of images at a time and this script names all the images "image 1" and so on to 500 at times.

Does anyone know how I can get the script to name each image with the product code the cell next to it? Essentially I have the address of the image in column A1...A500 and the corresponding product code in B1...B500. I want it to find the image in A1 and call it the code in B1 and not "image 1".

I'd be really grateful for any help...

Gordon.
Related:

3 responses

Answer 1 / 3
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Dec 3, 2019 at 12:16 PM
Hi Gordon,

"Image #" is the default name given. If you want to change it to the values in column B, add the following line:
Selection.ShapeRange.Name = cell.Offset(0, 1)

Insert it after this line:
If Pshp Is Nothing Then GoTo lab

Best regards,
Trowa

2
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019
Dec 3, 2019 at 01:37 PM
Hi TrowaD,

Thank you so much for getting involved. I tried your suggestion but not joy. Exactly the same outcome "Image#".

Hers what I did:

Sub URLPictureInsert()
'Updateby Extendoffice 20161116
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("A1:A6")
For Each cell In Rng
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
If Pshp Is Nothing Then GoTo lab
Selection.ShapeRange.Name = cell.Offset(0, 1)
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
.Width = 100
.Height = 100
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("A1").Select
Next
Application.ScreenUpdating = True
End Sub

On this test nothing happens at all. Notice I added you line and removed filenam = cell. When I leave filenam = cell in, it finds the images and gives them a generic name.

Any ideas?

Best,
Gordon.
0
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019
Dec 9, 2019 at 09:33 AM
Hi Trowa,

I'm beginning to feel this thread has fallen silent, any chance you could take a look at it again for me?

Best,
Gordon.
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Dec 9, 2019 at 11:56 AM
Hi Gordon,

Sorry for the wait, only active on Monday and Tuesday in December.

Nothing is happening, because you didn't define "filenam". So either put back the code line "filenam = cell" or replace "filenam" with "cell.value".

Other then that it should work:

Column A shows filename, column B shows image name. With the image selected, the image name is shown in the top left.

The name contains a space, because I thought that might be the issue, since you are not allowed to use spaces when naming ranges. But with images it still works, same goes

Maybe you had something else in mind, like selecting the image name the same as a named range?

Best regards,
Trowa
0
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019
Dec 9, 2019 at 02:08 PM
Hi Trowa,

No problem, I appreciate your help! Here's a screenshot of what I'm looking at...
As you can see, the images download but they don't have a name. When I right click to "Save As", to get an idea what the image is called, it's always called "Picture 1.png". Is this a Mac issue?

So the address of the image is in "A", and the image should be called whatever is in "B" on the same row...

Best,
Gordon.
0
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019
Dec 9, 2019 at 02:10 PM
Oh and this is the script so far...
0
Answer 2 / 3
Facebook
Updated on Nov 29, 2019 at 12:44 PM
So the problem isn't with the posted code, it is with the mystery script?
0
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019
Nov 30, 2019 at 09:11 AM
If you mean by “code” the code/script that I wrote originally, then that works just fine. It finds all the images and displays them in excel.
The problem is that I want the images to be named with the product code instead of just calling it “image 1” etc.
I feel as though the issue lies on line 10 (filenam = cell)
0
Answer 3 / 3
FacebookCoder
Updated on Dec 5, 2019 at 04:19 PM
Well, it runs right for me, as soon as you place the line back in to name the filename. Not certain what the issue is. Great job as always on this, TrowaD (you know who this is, but I no longer have access)!
0
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019
Dec 6, 2019 at 04:38 AM
Ok that's really interesting! So I'm doing something wrong clearly.... When you say "as soon as you place the line back in to name the filename." do you mean the "filenam = cell"? If not could you send me the exact script that you used? Fro the life of me, I was sure Trowa's idea was going to work.
0
LamoIdiot5 > Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019
Dec 6, 2019 at 07:21 AM
Yes that is what I meant.
0
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019 > LamoIdiot5
Dec 6, 2019 at 07:33 AM
Yep, well that's exactly what I did but somehow I'm not getting the same results.... Can you see any differences between your script and mine?
0
Gordon02812 Posts 11 Registration date Thursday November 28, 2019 Status Member Last seen December 9, 2019
Dec 6, 2019 at 04:55 AM
Ok this what my script looks like now, what am I missing!?

Sub URLPictureInsert()
'Updateby Extendoffice 20161116
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("A1:A6")
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
If Pshp Is Nothing Then GoTo lab
Selection.ShapeRange.Name = cell.Offset(0, 1)
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
.Width = 100
.Height = 100
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("A1").Select
Next
Application.ScreenUpdating = True
End Sub
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 555
Dec 9, 2019 at 11:58 AM
I figured as much M :)
0