Accessing an image that's inside of an Excel Table via VBA - excel

I am designing a VBA Form in Excel. The Workbook has a table called "images", and inside there I am dropping some images from my local hard drive.
These Workbook & UserForm are to be shared with my colleagues. They might not have these images in their harddrive, but they will have them inside of the Excel table.
I am looking for a way to load an image that's inside of a table inside of an "Image" VBA form control.
In Google all I find is how to load an image from my hard drive (i.e. using an absolute path like "C:/my_images/car.png"). What I can't find is how to load an image that's within a table, i.e. already bundled within the Workbook.
Any ideas?

If you are still interested in this question, I came up with a solution.
First you need to export the picture from the shape into a file. I found that only .jpg files can be used. My code generates a temporary filename (you need to be able to read/write that path but I think it is usually not a problem), and saves the picture by inserting it into a ChartObject, which can export its contents as a picture. I suppose this process may modify (e.g. compress) the original data but I saw no visible difference on the screen.
When this is done, it loads the picture from this file into the Image control on the UserForm.
Finally, it deletes the temporary file to clean up this side-effect.
Option Explicit
' Include: Tools > References > Microsoft Scripting Runtime
Private Sub cmdLoad_Click()
' Assumption: The UserForm on which you want to load the picture has a CommandButton, cmdLoad, and this function is its event handler
Dim imgImageOnForm As Image: Set imgImageOnForm = imgTarget ' TODO: Set which Control you want the Picture loaded into. You can find the Name in the VBA Form Editor's Properties Bar
Dim strSheetName As String: strSheetName = "TargetSheet" ' TODO: Specify the Name of the Worksheet where your Shape (picture) is
Dim strShapeName As String: strShapeName = "TargetPicture" ' TODO: Specify the Name of your Shape (picture) on the Worksheet
Dim strTemporaryFile As String: strTemporaryFile = GetTemporaryJpgFileName ' TODO: Give a path for the temporary file, the file extension is important, e.g. .jpg can be loaded into Form Controls, while .png cannot
LoadShapePictureToFormControl _
strSheetName, _
strShapeName, _
imgImageOnForm, _
strTemporaryFile
End Sub
Private Sub LoadShapePictureToFormControl(strSheetName As String, strShapeName As String, imgDst As MSForms.Image, strTemporaryFile As String)
' Note: This Sub overwrites the contents of the Clipboard
' Note: This Sub creates and deletes a temporary File, therefore it needs access rights to do so
Dim shpSrc As Shape: Set shpSrc = ThisWorkbook.Worksheets(strSheetName).Shapes(strShapeName)
Dim strTmp As String: strTmp = strTemporaryFile
ExportShapeToPictureFile shpSrc, strTmp
ImportPictureFileToImage strTmp, imgDst
FileSystem.Kill strTmp
End Sub
Private Sub ExportShapeToPictureFile(shpSrc As Shape, strDst As String)
shpSrc.CopyPicture xlScreen, xlBitmap
Dim chtTemp As ChartObject: Set chtTemp = shpSrc.Parent.ChartObjects.Add(0, 0, shpSrc.Width, shpSrc.Height)
With chtTemp
.Activate
.Parent.Shapes(.Name).Fill.Visible = msoFalse
.Parent.Shapes(.Name).Line.Visible = msoFalse
.Chart.Paste
.Chart.Export strDst
.Delete
End With
End Sub
Private Sub ImportPictureFileToImage(strSrc As String, imgDst As MSForms.Image)
Dim ipdLoaded As IPictureDisp: Set ipdLoaded = StdFunctions.LoadPicture(strSrc)
Set imgDst.Picture = ipdLoaded
End Sub
Private Function GetTemporaryJpgFileName() As String
Dim strTemporary As String: strTemporary = GetTemporaryFileName
Dim lngDot As Long: lngDot = InStrRev(strTemporary, ".")
If 0 < lngDot Then
strTemporary = Left(strTemporary, lngDot - 1)
End If
strTemporary = strTemporary & ".jpg"
GetTemporaryJpgFileName = strTemporary
End Function
Private Function GetTemporaryFileName() As String
Dim fsoTemporary As FileSystemObject: Set fsoTemporary = New FileSystemObject
Dim strResult As String: strResult = fsoTemporary.GetSpecialFolder(TemporaryFolder)
strResult = strResult & "\" & fsoTemporary.GetTempName
GetTemporaryFileName = strResult
End Function

Related

How decode QRcode selected in Excel VBA?

I would like to decode a QRcode selected in a worksheet excel but in vba. So I have this piece of code from Zxing library.
Function Decode_QR_Code_From_Byte_Array()
Dim reader As IBarcodeReader
Dim rawRGB(1000) As Byte
Dim res As Result
Set reader = New BarcodeReader
reader.options.PossibleFormats.Add BarcodeFormat_QR_CODE
Rem TODO: load bitmap data to byte array rawRGB
Set res = reader.DecodeImageBytes(rawRGB, 10, 10, BitmapFormat.BitmapFormat_Gray8)
End Function
My main problems are:
How worked with a selected qrcode in the worksheet in VBA ? (macro) Because I don't want to use "from file"
How decode it with the code ?
You do did not answer my clarification questions... I tried making a piece of code dealing with three shapes type. Please, try the next code. It assumes that the QR code shapes have similar names, able to be used to recognize them. I tried the first two characters to be "QR", but it can be changed for your case. If not a pattern, I also suppose that they should be added on a specific column. This can also be used to identify them.
Please, try the next approach:
Sub DecodeQR()
Dim ws As Worksheet, sh As Shape, chQR As ChartObject, QRFile As String
QRFile = ThisWorkbook.Path & "\QRPict.png"
Set ws = ActiveSheet 'any sheet to be processed
'Add a chart helper to export QR picture:
Set chQR = ws.ChartObjects.Add(left:=1, top:=1, width:=100, height:=100)
For Each sh In ActiveSheet.Shapes ' iterate between existing shapes
If left(sh.Name, 2) = "QR" Or left(sh.Name, 2) = "Pi" Then 'process only QR shapes
chQR.width = sh.width: chQR.height = sh.height 'chart dimensions
If sh.Type = 1 Or sh.Type = 11 Or sh.Type = 13 Then 'shapes keeping a picture
ExportQRPict sh, QRFile, chQR 'export picture to be used for decoding
Debug.Print sh.TopLeftCell.Address, Decode_QR_Code_From_File(QRFile) 'decoding
Else
Debug.Print "Unappropriate shape at " & sh.TopLeftCell.Address
End If
End If
Next sh
Kill QRFile: chQR.Delete
End Sub
Private Sub ExportQRPict(QRSh As Shape, QRFile As String, ch As ChartObject, Optional boolPict As Boolean)
QRSh.CopyPicture: ch.Activate: ActiveChart.Paste
ch.Chart.Export fileName:=QRFile, FilterName:="PNG"
End Sub
Function Decode_QR_Code_From_File(pictPath) As String
Dim reader As IBarcodeReader
Dim res As result
Set reader = New BarcodeReader
reader.Options.PossibleFormats.Add BarcodeFormat_QR_CODE
Set res = reader.DecodeImageFile(pictPath)
Decode_QR_Code_From_File = res.text
End Function
Usually, the QR code shapes are placed to the right side of the cell keeping the text to be encoded. If this is the case, or any relation between the shape cell to belong and the cell keeping the text to be encoded exists, the above code can be adapted to check if the decoded text is the same with the reference one.

Updating Links via VBA

I am trying to update a file that is linked to three other files using VBA.
My code works, however, it requires all three files paths to be the same. How can I modify my code to allow all three links to be different?
Sub UpdateLinks()
Dim NewLink As Variant
Dim links As Variant
Dim i As Integer
links = ActiveWorkbook.LinkSources(xlExcelLinks)
NewLink = Application.GetOpenFilename
For i = 1 To UBound(links)
ActiveWorkbook.ChangeLink Name:=links(i), NewName:= NewLink, _
Type:=xlExcelLinks
Next i
End Sub

Rotate picture in user form

I'm trying to rotate an image inside an user form, here is the cose I'm using:
Private Declare Function GetTempPath Lib "kernel32" Alias"GetTempPathA_(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Dim NewPath As String
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
Sub RotatePic(deg As Long)
Dim ws As Worksheet
Dim p As Object
Dim chrt As Chart
'~~> Adding a temp sheet
Set ws = ThisWorkbook.Sheets.Add
'~~> Insert the picture in the newly created worksheet
Set p = ws.Pictures.Insert(**PROBLEM**)
'~~> Rotate the pic
p.ShapeRange.IncrementRotation deg
'~~> Add a chart. This is required so that we can paste the picture in it
'~~> and export it as jpg
Set chrt = Charts.Add()
With ws
'~~> Move the chart to the newly created sheet
chrt.Location Where:=xlLocationAsObject, Name:=ws.Name
'~~> Resize the chart to match shapes picture. Notice that we are
'~~> setting chart's width as the pictures `height` becuse even when
'~~> the image is rotated, the Height and Width do not swap.
With .Shapes(2)
.Width = p.Height
.Height = p.Width
End With
.Shapes(p.Name).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
'~~> Temp path where we will save the pic
NewPath = TempPath & "NewFile.Jpg"
'~~> Export the image
.ChartObjects(1).Chart.Export filename:=NewPath, FilterName:="jpg"
End With
'~~> Delete the temp sheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub
the problem (you can see PROBLEM in the code) is that I don't know how to get the path of the picture that is in image box (I upload the picture through a image dialog)
How can I solve?
May simply try like this
Code:
Private Sub CommandButton1_Click()
Me.Image1.Picture = LoadPicture("C:\users\user\desktop\Range.jpg")
End Sub
Sub test()
Dim Ws As Worksheet, fname As String
Dim Shp As ShapeRange, p As Object
Dim Chrt As Chart
fname = "C:\users\user\desktop\TempXXX.jpg"
Set Ws = ThisWorkbook.Sheets("Sheet1")
SavePicture Me.Image1.Picture, fname
DoEvents
Set p = Ws.Pictures.Insert(fname)
p.ShapeRange.Rotation = 90
Ws.Shapes(p.Name).Copy
Set Chrt = Ws.ChartObjects.Add(10, 10, Ws.Shapes(p.Name).Height, Ws.Shapes(p.Name).Width).Chart
Chrt.Paste
Chrt.Export Filename:=fname, FilterName:="jpg"
DoEvents
Me.Image1.Picture = LoadPicture(fname)
'clean temp objects
Kill fname
p.Delete
Chrt.Parent.Delete
End Sub
Private Sub CommandButton2_Click()
test
End Sub
The ".chart" method described above is a hack. It cost me 12 hours of debugging due to the code running faster than the system as it rotates large images (which is pretty much the standard for most phones and cameras these days). Issues such as the resulting image being a blank image, to the unchanged image being loaded back into the UserForm (because the code has run on to insert the image from the specified directory before the system has replaced it with the rotated image. No amount of Wait, Sleep, DoEvents, solved this. It works when stepping through fine but not in real-time for me, I'm afraid.
The solution is to implement the Windows Image Acquisition API. Daniel Pineault has developed a tidy VBA function here. This should be the go-to solution.

VBA: Chart.export produces corrupt image - until scrolled over or chart.activate

I have a form that manipulates a chart and then exports it, like so:
Workbooks(sWB).Sheets("Output").Unprotect sPW
Workbooks(sWB).Sheets("Output").ChartObjects(1).Chart.Export strDocName
However, occasionally this doesn't work properly anymore and a corrupt image is exported each time. Going to the sheet with the chart and scrolling over it (without clicking) solves the issue for a while. For now I fixed it like this:
Workbooks(sWB).Sheets("Output").Unprotect sPW
Workbooks(sWB).Sheets("Output").ChartObjects(1).Activate 'chart sometimes falls asleep somehow, maybe this will fix
Workbooks(sWB).Sheets("Output").ChartObjects(1).Chart.Export strDocName
This seems to have solved the issue which I dubbed "sleeping charts" for now.
However, I would like to understand how this works, and to fix it without using "Activate" as that can impact the user experience of my users (who use multiple Excel sheets along this VBA-excel form).
Anyone who understands what happens here?
Full function code chain
Private Sub C171CmdLe1Dr1Graph_Click()
Call ShowGraph(1, 1, True)
End Sub
Private Sub ShowGraph(ByVal intLeNr As Integer, ByVal intDrNr As Integer, ByVal Show As Boolean) 'Delete
Dim strDocName As String
Dim strLeNr As String
Dim oChart As Frm_DCT_ShowGraph
Call dle(intLeNr - 1).DrawChart(intLeNr, intDrNr)
'export the chart
strDocName = strMyDocsPath & "\DRT_Chart" & Right(strLeNr, 1) & ".gif"
Workbooks(sWB).Sheets("Output").Unprotect sPW
Workbooks(sWB).Sheets("Output").ChartObjects(1).Activate 'chart sometimes falls asleep somehow, maybe this will fix
Workbooks(sWB).Sheets("Output").ChartObjects(1).Chart.Export strDocName
If Show Then
'create new chart, load it and show it
Set oChart = New Frm_DCT_ShowGraph
oChart.DocName = strDocName
oChart.Show vbModeless
End If
Workbooks(sWB).Sheets("Output").Protect sPW
DoEvents
End Sub
Public Sub DrawChart(ByVal intLeNr As Integer, ByVal intDrNr As Integer)
Dim lngN As Long
Dim sngPlotArr() As Single
Dim strIRange As String
Dim strURange As String
...
'create plot data
Call cDriver(intDrNr - 1).Plot(sngPlotArr)
'unlock worksheet
Workbooks(sWB).Sheets("Output").Unprotect sPW
'clear range first
Workbooks(sWB).Sheets("Output").Range(strIRange).Clear
Workbooks(sWB).Sheets("Output").Range(strURange).Clear
'fill in data
For lngN = 0 To UBound(sngPlotArr, 1)
Workbooks(sWB).Sheets("Output").Range(strIRange).Columns(lngN + 1).Value2 = sngPlotArr(lngN, 0)
Workbooks(sWB).Sheets("Output").Range(strURange).Columns(lngN + 1).Value2 = sngPlotArr(lngN, 1)
'give OS some time
If lngN Mod 100 = 0 Then
DoEvents
End If
Next
...
'relock
Workbooks(sWB).Sheets("Output").Protect sPW
End Sub

How do I rotate a saved image with VBA?

I currently have a userform in excel with images displayed on it (saved in a temporary folder "C:\Temp\Photos")
What I want to do is have buttons (90, 180, 270) for rotating the images located in "C:\Temp\Photos". Thinking it may be an FileSystemObject but dont know enough about them yet to know how to do this.
EDIT: Added some code by request. Pictures are inserted depending on value selected in combobox. Any changes would reference pic1-pic5 (only ever 5 pics at any time).
Private Sub ComboBox1_Change()
pic1 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\1.jpg"
pic2 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\2.jpg"
pic3 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\3.jpg"
pic4 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\4.jpg"
pic5 = "C:\Temp\Photos\" & Me.ComboBox1.Text & "\5.jpg"
If Dir(pic1) <> vbNullString Then
Me.Image1.Picture = LoadPicture(pic1)
Else
Me.Image1.Picture = LoadPicture("")
End If
If Dir(pic2) <> vbNullString Then
Me.Image2.Picture = LoadPicture(pic2)
Else
Me.Image2.Picture = LoadPicture("")
End If
If Dir(pic3) <> vbNullString Then
Me.Image3.Picture = LoadPicture(pic3)
Else
Me.Image3.Picture = LoadPicture("")
End If
If Dir(pic4) <> vbNullString Then
Me.Image4.Picture = LoadPicture(pic4)
Else
Me.Image4.Picture = LoadPicture("")
End If
If Dir(pic5) <> vbNullString Then
Me.Image5.Picture = LoadPicture(pic5)
Else
Me.Image5.Picture = LoadPicture("")
End If
End Sub
Like I mentioned, there is no inbuilt way to rotate a picture in userform. Having said that, there is an alternative to achieve what you want. Below I have demonstrated on how to rotate the image 90 degrees.
Logic:
Insert a temp sheet
Insert the image into that sheet
Use IncrementRotation rotation property
Export the image to user's temp directory
Delete the temp sheet
Load the image back
Preparing your form
Create a userform and insert an image control and a command button. Your form might look like this. Set the Image Control's PictureSizeMode to fmPictureSizeModeStretch in the properties window.
Code:
I have written a sub RotatePic to which you can pass the degree. Like I mentioned that This example will rotate it 90 degrees as I am just demonstrating for 90. You can create extra buttons for rest of the degrees. I have also commented the code so you shouldn't have any problem understanding it. If you do then simply ask :)
Option Explicit
'~~> API to get the user's temp folder path
'~~> We will use this to store the rotated image
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Dim NewPath As String
'~~> Load the image on userform startup
Private Sub UserForm_Initialize()
Image1.Picture = LoadPicture("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
End Sub
'~~> Rotating the image 90 degs
Private Sub CommandButton1_Click()
RotatePic 90
DoEvents
Image1.Picture = LoadPicture(NewPath)
End Sub
'~~> Rotating the image
Sub RotatePic(deg As Long)
Dim ws As Worksheet
Dim p As Object
Dim chrt As Chart
'~~> Adding a temp sheet
Set ws = ThisWorkbook.Sheets.Add
'~~> Insert the picture in the newly created worksheet
Set p = ws.Pictures.Insert("C:\Users\Public\Pictures\Sample Pictures\Koala.jpg")
'~~> Rotate the pic
p.ShapeRange.IncrementRotation deg
'~~> Add a chart. This is required so that we can paste the picture in it
'~~> and export it as jpg
Set chrt = Charts.Add()
With ws
'~~> Move the chart to the newly created sheet
chrt.Location Where:=xlLocationAsObject, Name:=ws.Name
'~~> Resize the chart to match shapes picture. Notice that we are
'~~> setting chart's width as the pictures `height` becuse even when
'~~> the image is rotated, the Height and Width do not swap.
With .Shapes(2)
.Width = p.Height
.Height = p.Width
End With
.Shapes(p.Name).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
'~~> Temp path where we will save the pic
NewPath = TempPath & "NewFile.Jpg"
'~~> Export the image
.ChartObjects(1).Chart.Export Filename:=NewPath, FilterName:="jpg"
End With
'~~> Delete the temp sheet
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub
'~~> Get the user's temp path
Function TempPath() As String
TempPath = String$(MAX_PATH, Chr$(0))
GetTempPath MAX_PATH, TempPath
TempPath = Replace(TempPath, Chr$(0), "")
End Function
In Action
When you run the userform, the image is uploaded and when you click on the button, the image is rotated!
The only way I see of doing this would be to copy the picture into a chart, rotate it, export it, and re-open it inside the form the same way you are displaying pictures right now.
Try this.
Change
If Dir(pic1) <> vbNullString Then
Me.Image1.Picture = LoadPicture(pic1)
Else ...
To
If Dir(pic1) <> vbNullString Then
pic1 = myFunction(pic1, rotationDegree)
Me.Image1.Picture = LoadPicture(pic1)
Else ...
(And everywhere else this structure is used)
Insert, inside a module, the following function :
Public Function myFunction(myPicture As String, myRotation As Integer) As String
ActiveSheet.Pictures.Insert(myPicture).Select
Selection.ShapeRange.IncrementRotation myRotation
Selection.CopyPicture
tempPictureName = "C:\testPic.jpg"
'Change for the directory/filename you want to use
Set myChart = Charts.Add
myChart.Paste
myChart.Export Filename:=tempPictureName, Filtername:="JPG"
Application.DisplayAlerts = False
myChart.Delete
Selection.Delete
Application.DisplayAlerts = True
myFunction = myDestination
End Function
EDIT : Took so long to get the time to finish writing the post (from work) that I missed the other user's answer, which seems to use the same logic. However, my approach might be easier to use for you!
EDIT2 : rotationDegree needs to be set to the degree of the rotation (which needs to be determined before retrieving the picture).

Resources