VBA – Transferring picture to worksheet pixel by pixel

[Worf]

Worf submitted a new Excel article:

VBA – Transferring picture to worksheet pixel by pixel - This code shows how to transfer an image to worksheet cells. Each pixel will correspond to a cell.

Say that you want to analyze the color distribution of a given picture. One way to do this is to have each worksheet cell representing one image pixel.

To use the code, run the transfer routine, specifying the sheet and the shape name.

View attachment 30058

#If VBA7 Then
 Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'For 64 Bit Systems
#Else
 Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'For 32 Bit...

Read more about this Excel article...

 

[michaelroshan]

Sir,
I have a workbook that has 1500 itmes as inventory and items going out and coming in everyday.
I have a userform which i have bult to manage this with ease all items linked to an itemcode. I would like to display the item image as well in the same userform when item is recalled by item code. how can i do this? i there is a method where we can store all images in a folder and all items names with the matching item code but i have no clue how to link them with VBA and display it on the user form.
Can you help on this?

 

[Worf]

Hello Michael

I will analyze your request as soon as possible.

 

[slim313]

the sample code almost drives me to the target. But tPicSize.Height and tPicSize.Width are both -1 for unknown reason.
a temp solution is to make the # of rows and columns for outputs contant. Part of the images can be transferred.

Sub Transfer()
Dim lPixelColor, tPt As POINTAPI, tPicSize As Size, i, j, im, jm
tPt.x = 23
tPt.y = 12
lPixelColor = GetPixelColorFromShape(Sheet2.Shapes("Picture 2"), tPt, tPicSize)
im = tPicSize.Height
jm = tPicSize.Width
Application.ScreenUpdating = False
For i = 1 To 30 ' 30 is originally the "im" varaible. but for unknown reason, it is always -1.
Application.StatusBar = Format(i / im, "0%")
For j = 1 To 30 'jm
tPt.x = j
tPt.y = i
lPixelColor = GetPixelColorFromShape(Sheet2.Shapes("Picture 2"), tPt, tPicSize)
Sheets("map").Cells(i, j).Interior.Color = lPixelColor
Next j, i
Application.ScreenUpdating = True
End Sub


Please advise.

BTW, in windows 10 64 bits version there are several modifications:
"olepro32.dll" should be replaced by "oleaut32.dll"
"Private Declare Function" should be replaced by "Private Declare PtrSafe Function"

 

[Worf]

Michael

I created a new article based on your request. Maybe you could start a thread on this topic, there we would have more room to develop the subject.

Slim

I will analyze your problem as soon as possible.

Dynamic user form images with VBA

 

[Worf]

Slim

I was not able to reproduce the problem. Can you provide a link to a workbook containing an image that causes the problem? I would like to test it on my computer.

 

[Ivan M]

Good code.

 

[bartmaster]

HI @Worf
I've just found your code here:
VBA – Transferring picture to worksheet pixel by pixel
I am unable to run the Transfer routine on my 64bit excel 2016 windows10 version due to the following error and lines highlighted in red.