Previous Topic Next Topic

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

Closed
Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019 - 29 Nov 2019 à 09:35
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 - 10 Dec 2019 à 11:50
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

Réponse 1 / 3
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 555
3 Dec 2019 à 12:16
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

Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019
3 Dec 2019 à 13:37
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.
Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019
9 Dec 2019 à 09:33
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.
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 555
9 Dec 2019 à 11:56
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
Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019
9 Dec 2019 à 14:08
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.
Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019
9 Dec 2019 à 14:10
Oh and this is the script so far...
Réponse 2 / 3
Facebook
29 Nov 2019 à 12:44
So the problem isn't with the posted code, it is with the mystery script?
Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019
30 Nov 2019 à 09:11
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)
Réponse 3 / 3
FacebookCoder
5 Dec 2019 à 16:19
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)!
Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019
6 Dec 2019 à 04:38
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.
LamoIdiot5 > Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019
6 Dec 2019 à 07:21
Yes that is what I meant.
Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019 > LamoIdiot5
6 Dec 2019 à 07:33
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?
Gordon02812 Posts 11 Registration date Thursday 28 November 2019 Status Member Last seen 9 December 2019
6 Dec 2019 à 04:55
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
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 555
9 Dec 2019 à 11:58
I figured as much M :)

Similar discussions

Cannot download multiple files at once in WhatsApp Web
nemonavicusrino -
dannygzus -

4 responses
How do I extract specific data from a cell in excel?
mcat79 -
ac3mark -

5 responses
Sims 2!! Custom content pleasee helpp me!! :(
smiley cupcakee xx :] -
Levy -

25 responses