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.
Related
I am trying to develop a VBA solution within Excel that can identify which shapes are connected to eachother within a worksheet via a standard connector line.
For example, in the snippet attached, I need to create a code that can identify that the control square is connected to the two red circles (titled Risk 1 and Risk 2) and output the following in a message box: "Risk 1 and Risk 2 are connected to Control". I have been able to find code to add connector lines however I cannot figure out how to identify connected shapes. Any guidance would be greatly appreciated! I have also attached the code that I have been able to find thus far.
Sub QuickConnect( )
Dim s1 As Shape, s2 As Shape, conn As Shape
' Create a shape
Set s1 = ActiveSheet.Shapes.AddShape(msoShapeCube, 100, 10, 50, 60)
' Create another shape
Set s2 = ActiveSheet.Shapes.AddShape(msoShapeCan, 50, 100, 50, 60)
' Create connector with arbitrary coordinates
Set conn = ActiveSheet.Shapes.AddConnector(msoConnectorCurve, 1, 1, 1, 1)
' Connect shapes
conn.ConnectorFormat.BeginConnect s1, 1
conn.ConnectorFormat.EndConnect s2, 1
' Connect via shortest path (changes connection sites)
conn.RerouteConnections
End Sub
Therefore you need to loop through all shapes, check if they are a connector (yes, connector lines are shapes too). And then you can check which shapes are connected by this connector line:
The property .ConnectorFormat.BeginConnectedShape gives you the shape at one end of the connector line and .ConnectorFormat.EndConnectedShape the shape on the other end.
Checkout this:
Option Explicit
Public Sub TestConnections()
Dim shp As Variant
For Each shp In Shapes 'loop through all shapes
If shp.Connector = msoTrue Then 'check if current shape is a connector
'BeginConnectedShape is the shape on the beginning side of the connector
'EndConnectedShape is the shape on the ending side of the connector
Debug.Print shp.Name _
& " connects " & _
shp.ConnectorFormat.BeginConnectedShape.Name _
& " with " & _
shp.ConnectorFormat.EndConnectedShape.Name
End If
Next shp
End Sub
For the following shapes
it outputs
Curved Connector 3 connects Cube 1 with Can 2
Curved Connector 6 connects Cube 5 with Can 2
You can use ConnectorFormat.EndConnectedShape property (Excel) and ConnectorFormat.BeginConnectedShape property (Excel) to achieve what you want.
LOGIC:
Loop through all connector shapes.
Create a Unique collection of shapes to which other shapes are connected with.
Get the Beginning and the Ending shape names.
Find the relation i.e WHO is connected to WHO.
CODE:
I have commented the code but if you still have questions then feel free to ask.
Option Explicit
'~~> Change this if your shapes include the below text
Const mySep As String = "MySep"
Sub Sample()
Dim ws As Worksheet
Dim shpConnector As Shape
Dim shpConnectorCount As Long
Dim i As Long: i = 1
Dim tmpAr As Variant, itm As Variant
Dim colConnector As New Collection
Dim msg As String
Dim finalOutput As String
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
'~~> Count the number of connector shapes
For Each shpConnector In .Shapes
If shpConnector.Connector Then shpConnectorCount = shpConnectorCount + 1
Next shpConnector
'~~> If not found then exit sub
If shpConnectorCount = 0 Then Exit Sub
'~~> Resize array based on connector count
ReDim tmpAr(1 To shpConnectorCount)
For Each shpConnector In .Shapes
With shpConnector
If .Connector Then
'~~> Unique collection of shapes to which other
'~~> shapes are connected with
On Error Resume Next
colConnector.Add CStr(.ConnectorFormat.EndConnectedShape.Name), _
CStr(.ConnectorFormat.EndConnectedShape.Name)
On Error GoTo 0
'~~> Store Starting shape and End Shape in an array
tmpAr(i) = .ConnectorFormat.BeginConnectedShape.Name & mySep _
& .ConnectorFormat.EndConnectedShape.Name
i = i + 1
End If
End With
Next
'~~> Loop through the unique collection and the array to create
'~~> Our necessary output
For Each itm In colConnector
msg = ""
For i = LBound(tmpAr) To UBound(tmpAr)
If Split(tmpAr(i), mySep)(1) = itm Then
msg = msg & "," & Split(tmpAr(i), mySep)(0)
End If
Next i
finalOutput = finalOutput & vbNewLine & Mid(msg, 2) & " is/are connected to " & itm
Next itm
End With
MsgBox Mid(finalOutput, 2)
End Sub
IN ACTION:
SCREENSHOT:
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
Program: Excel 2016.
I have a sheet with a lot of shapes. Each of them has its own specific name and most of them are label. I want to change their caption property, but i can't find a way but calling them one by one like this:
LblLabel_1.Caption = ...
LblLabel_2.Caption = ...
LblLabel_3.Caption = ...
Instead i was looking for something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01).Caption = ...
Next
This one will result in error 438, basically saying Caption is not avaiable for this object. It still target the object, since this code:
Debug.print Shapes("LblLabel_" & BytCounter01).Name
will return me its name.
Looking for a solution:
-i've tried Controls("LblLabel_" & BytCounter01) instead of Shapes("LblLabel_" & BytCounter01) but it won't work since Controls is only for userforms, not for sheets;
-i've tried Shapes("LblLabel_" & BytCounter01).TextFrame.Characters.Text but it returns error 438 again;
-since the label is a part of a group, i've tried both
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).Caption
and
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).TextFrame.Characters.Text
but got 438 again.
Is there really no way to easily target a specific label on a sheet and change his caption?
Thank you.
EDIT: thanks to Excelosaurus, the problem is solved. Since my labels are ActiveX Controls i have to use something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01)OLEFormat.Object.Object.Caption = ...
Next
You can check his response and comments for more details. Thanks again Excelosaurus!
To change the textual content of a shape, use .TextFrame2.TextRange.Text as shown below:
shtShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
where shtShapes is the name of your worksheet's object as seen from the Visual Basic Editor in the Project Explorer,
sShapeName is a string variable containing the name of the target shape, and
sShapeCaptionis a string variable containing the desired caption.
A code example follows. I've thrown in a function to check for a shape's existence on a worksheet, by name.
Option Explicit
Public Sub SetLabelCaptions()
Dim bCounter As Byte
Dim sShapeName As String
Dim sShapeCaption As String
For bCounter = 1 To 255
sShapeName = "LblLabel_" & CStr(bCounter)
If ShapeExists(shtMyShapes, sShapeName) Then
sShapeCaption = "Hello World " & CStr(bCounter)
shtMyShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
Else
Exit For
End If
Next
End Sub
Public Function ShapeExists(ByVal pshtHost As Excel.Worksheet, ByVal psShapeName As String) As Boolean
Dim boolResult As Boolean
Dim shpTest As Excel.Shape
On Error Resume Next
Set shpTest = pshtHost.Shapes(psShapeName)
boolResult = (Not shpTest Is Nothing)
Set shpTest = Nothing
ShapeExists = boolResult
End Function
The result should look like this:
You can't assign a Caption to a Shape. (Shapes don't have Captions). One approach is to loop over the Shapes and build a little table to tell you what to loop over next:
Sub WhatDoIHave()
Dim kolumn As String, s As Shape
Dim i As Long, r As Range
kolumn = "Z"
i = 1
For Each s In ActiveSheet.Shapes
Set r = Cells(i, kolumn)
r.Value = i
r.Offset(, 1).Value = s.Name
r.Offset(, 2).Value = s.Type
r.Offset(, 3).Value = s.TopLeftCell.Address(0, 0)
i = i + 1
Next s
End Sub
Which for my sample produced:
Seeing that I have both Forms and ActiveX (OLE) Controls, I know what to loop over next. I then refer to the Control by number and assign a Caption if appropriate.
I am trying to obtain a reference to a Shape in a Worksheet, corresponding to a ChartObject. I found no certain way of doing this. The only approximation, by trial-and-error and simply tested in a few cases, is assuming that the ZOrder of a ChartObject is the same as the Index of the corresponding Shape:
Function chobj2shape(ByRef cho As ChartObject) As Shape
' It appears that the ZOrder of a ChartObject is the same as the Index of
' the corresponding Shape, which in turn appears to be the same as its ZOrderPosition
Dim zo As Long
Dim ws As Worksheet
Dim shc As Shapes
Dim sh As Shape
zo = cho.ZOrder
Set ws = cho.Parent
Set shc = ws.Shapes
Set sh = shc.Item(zo)
Set chobj2shape = sh
'Set sh = Nothing
End Function
(a slight excess of defined variables is used for debugging purposes).
Is there any more certain way of doing this?
Any identifier used for picking the correct Shape should be unique. The name is not necessarily unique (see https://stackoverflow.com/questions/19153331/duplicated-excel-chart-has-the-same-name-name-as-the-original-instead-of-increm), so it is not guaranteed to work. The Index/ZOrderPosition is just a guess, at least satisfying the requirement of uniqueness.
Edit: see answer by #Andres in Excel VBA: Index = ZOrderPosition in a Shapes collection?. It is clear that the ZOrder of a ChartObject is not equal to the Index of either the ChartObject or the corresponding Shape (and I have verified this).
But it appears that ZOrder is equal to ZOrderPosition of the corresponding Shape. This was verified with dump_chartobjects:
Sub dump_chartobjects()
' Dump information on all ChartObjects in a Worksheet.
Dim coc As ChartObjects
Set coc = ActiveSheet.ChartObjects
Dim cho As ChartObject
Dim ich As Long
For ich = 1 To coc.Count
Dim msg As String
Set cho = coc(ich)
With cho
msg = "ChartObject '" & .name & "'" _
& ", type name: " & TypeName(cho) & ", at: " & .TopLeftCell.Address _
& ", index: " & ich & ", .Index: " & .Index _
& ", ZOrder: " & .ZOrder
'& ", hyperlink: " & .Hyperlink
End With
Debug.Print msg
Dim ish As Long
ish = choidx2shpidx(ich, coc.Parent)
Next ich
End Sub
Function choidx2shpidx(coidx As Long, ws As Worksheet) As Long
Dim cozo As Long
Dim coc As ChartObjects
Dim co As ChartObject
Set coc = ws.ChartObjects
Set co = coc(coidx)
cozo = co.ZOrder
choidx2shpidx = zo2idx_shp(cozo, ws)
Dim con As String, shn As String
Dim sh As Shape
Set sh = ws.Shapes(choidx2shpidx)
con = co.name
shn = sh.name
Dim cox As Double, coy As Double
Dim cow As Double, coh As Double
Dim shx As Double, shy As Double
Dim shw As Double, shh As Double
cox = co.Left
coy = co.top
cow = co.Width
coh = co.Height
shx = sh.Left
shy = sh.top
shw = sh.Width
shh = sh.Height
If ((con <> shn) Or (cox <> shx) Or (coy <> shy) Or (cow <> shw) Or (coh <> shh)) Then
Dim msg As String
msg = "ChartObject: '" & con & "', Shape: '" & shn & "'"
'Debug.Print msg
MsgBox msg
choidx2shpidx = -1
End If
End Function
Function zo2idx_shp(zo As Long, ws As Worksheet) As Long
Dim ish As Long
Dim shc As Shapes
Dim sh As Shape
Set shc = ws.Shapes
For ish = 1 To shc.Count
Set sh = shc(ish)
If (sh.ZOrderPosition = zo) Then
zo2idx_shp = ish
Exit Function
End If
Next ish
zo2idx_shp = -1
End Function
After losing hours in a similar issue, I found a couple of concepts related to referencing shapes in excel, but none satisfies me 100%. For accessing a shape you have 4 pure methods:
Shape.Name : Is FAST, but NOT RELIABLE. The name of the shape could be used to get a reference of a shape but provided you don't have duplicated names. Code: ActiveSheet.Shapes("Shape1")
Shape.ZOrderPosition : Very FAST, but NOT RELIABLE. The ZOrder of the shape could be used to get a reference of a shape, because is the same as the index of the shape in the shapes collection. But provided you don't have group of shapes that breaks previous rule (See: https://stackoverflow.com/a/19163848/2843348). Code: ActiveSheet.Shapes(ZOrderFromOneShape)
Set shpRef=Shape: FAST, RELIABLE, but NOT PERSISTENT. I try to use this always I can, specially when I create a new shape. Moreover, if I have to iterate on the new shapes later one I try to keep the object reference inside a collection. However not Persistent, that means if you stop and run you VBA code again to will loose all the references and collection. Code: Set shp = NewShape, or you can add it to a collection: coll.add NewShape for loop it later on.
Shape.ID : RELIABLE, PERSISTENT, but not directly supported! The ID of the shape is very reliable (don't change and cannot be duplicates IDs in a Sheet). However, there is no direct VBA function to get a shape back knowing its ID. The only way is to loop thorough all shapes until the ID match the ID you was looking for, but this can be very SLOW!.
Code:
Function FindShapeByID(ws as excel.worksheet, ID as long) as Excel.Shape
dim i as long
set FindShapeByID = nothing 'Not found...
for i = 1 to ws.shapes.count
if ws.shapes(i).ID = ID then
set FindShapeByID = ws.shapes(i) 'Return the shape object
exit function
end if
next i
End Function
Note 1: If you want to access this function several times, you can improve it by using a cache of Shape IDs. That way you will make the loop only one time.
Note 2: If you move a shape from one sheet to other, the ID of the shape will change!
By mixing and using above knowledge, I have concluded in two main approaches:
FIRST APPROACH
FASTEST BUT VOLATILE: (same as point#3) Try to keep the reference in a object as longer you can. When I have to iterate trough a bunch of shapes later on, I save the references inside a collection and I avoid to use other secondary reference like the name, ZOrder or ID.
For example:
dim col as new Collection
dim shp as Excel.Shape
'' <- Insert the code here, where you create your shape or chart
col.add shp1
'' <- Make other stuffs
for each shp in col
'' <- make something with the shape in this loop!
next shp
The problem of course is that the collection and reference are not permanent. You will loose them when you stop and restart the vba code!
SECOND APPROACH
PERSISTENT: My solution is to save the name and the ID of the shape for later reference. Why? Having the name I can access the shape very fast most of the time. Just in case I found a duplicated name I make the slow loop searching the ID. How can I know if there is a name duplicated? Very simple, just check the ID of the first name search, and if they don't match you have to suppose is duplicated.
Here the code:
Function findShapeByNameAndID(ws As Excel.Worksheet, name As String, ID As Long) As Shape
Dim sh As Excel.Shape
Set findShapeByNameAndID = Nothing 'Means not found
On Error GoTo fastexit
Set sh = ws.Shapes(name)
'Now check if the ID matches
If sh.ID = ID Then
'Found! This should be the usual case!
Set findShapeByNameAndID = sh
Else
'Ups, not the right shape. We ha to make a loop!
Dim i As Long
For i = 1 To ws.Shapes.Count
If ws.Shapes(i).ID = ID Then
'Found! This should be the usual case!
Set findShapeByNameAndID = ws.Shapes(i)
End If
Next i
End If
fastexit:
Set sh = Nothing
End Function
Hope this helps you!
Note 1: Is you want to search shapes that maybe inside groups, then the function is more complicated.
Note 2: The ZOrder looks nice, but cannot find it useful. When I tried to take advantage of it, there was always a missing part...
#TimWilliams is almost right (in his comment). However, there are some situation where Tim's idea could get confusing results.
I think the following code will be more appropriate and correct.
Sub qTest()
Dim cho As ChartObject
Set cho = ActiveSheet.ChartObjects(1)
Dim SH As Shape
Set SH = cho.ShapeRange.Item(1)
SH.Select 'here Shape will be selected..
Debug.Print TypeName(SH) '...which we can check here
End Sub
I've used a small subroutine to insert a picture into my sheet by
ActiveSheet.Pictures.Insert(URL).Select
This works fine with Excel 2003 (Windows), but does not work with Excel 2011 (Mac) any more.
Therefore I modified my subroutine
(like proposed http://www.launchexcel.com/google-maps-excel-demo/),
but the subroutine stops at
theShape.Fill.UserPicture URL
with the error message
"-2147024894 (80070002) Fehler der Methode UserPicture des Objekts FillFormat"
The rectangle is green!
Sub Q1()
Dim wks As Worksheet
Dim URL As String
Dim i As Long
Dim lastRow As Long
Dim theShape As Shape
Dim pasteCell As Range
' Used Worksheet
Set wks = Worksheets("Blatt1")
' Delete already existing shapes
For Each theShape In wks.Shapes
theShape.Delete
Next theShape
' Check all existing rows in Column K
lastRow = Cells(Rows.Count, "K").End(xlUp).Row
For i = 2 To lastRow
' the URLs are already computed and stored in column K
URL = wks.Range("K" & i).Value
' try to put the images in column L
Set pasteCell = wks.Range("L" & i)
pasteCell.Select
' Create a Shape for putting the Image into
' ActiveSheet.Pictures.Insert(URL).Select is deprecated and does not work any more!!!
Set theShape = wks.Shapes.AddShape(msoShapeRectangle, pasteCell.Left, pasteCell.Top, 200, 200)
' fill the shape with the image after greening
theShape.Fill.BackColor.RGB = RGB(0, 255, 0)
theShape.Fill.UserPicture URL
Next i
End Sub
Any suggestions or hints? Probably I'm blind as a bat....
Have you tried syntax along the lines of this for setting a shape to a URL:
Sub Picadder()
Dim Pic As Shape
Set Pic = ActiveSheet.Shapes.AddPicture("http://stackoverflow.com/content/stackoverflow/img/apple-touch-icon.png", msoFalse, msoTrue, 0, 0, 100, 100)
End Sub
This code, when adapted to your efforts, might look something along the lines of this:
Sub Q1()
Dim wks As Worksheet
Dim URL As String
Dim i As Long
Dim lastRow As Long
Dim theShape As Shape
Dim pasteCell As Range
' Used Worksheet
Set wks = Worksheets("Blatt1")
' Delete already existing shapes
For Each theShape In wks.Shapes
theShape.Delete
Next theShape
' Check all existing rows in Column K
lastRow = Cells(Rows.Count, "K").End(xlUp).Row
For i = 2 To lastRow
' the URLs are already computed and stored in column K
URL = wks.Range("K" & i).Value
' try to put the images in column L
Set pasteCell = wks.Range("L" & i)
pasteCell.Select
' Create a Shape for putting the Image into
' ActiveSheet.Pictures.Insert(URL).Select is deprecated and does not work any more!!!
Set theShape = wks.Shapes.AddPicture(URL, pasteCell.Left, pasteCell.Top, 200, 200)
' Set shape image backcolor.
theShape.Fill.BackColor.RGB = RGB(0, 255, 0)
Next i
End Sub
Your urls will need to be properly formatted - I had to use quotations on my URL for the initial snippet to get it function effectively, but it may be a solution.
For Mac-Excel 2011, there is a workaround discussed by Michael McLaughlin on his blog. Evidently, it is not easy to tie images to cells in Mac-Excel 2011, if at all. Moreover, research reveals that the question of inserting images into an excel workbook has been asked many times. It also appears that it has not been readily solved through picture methods thus far in the research. Thus, a work-around may be the best solution.
The code snippet, which was very closely adapted and ported from Michael's blog, is as follows:
Function InsertImageCommentAsWorkAround(title As String, cellAddress As Range)
' Define variables used in the comment.
Dim ImageCommentContainer As comment
' Clear any existing comments before adding new ones.
Application.ActiveCell.ClearComments
' Define the comment as a local variable and assign the file name from the _
' _ cellAddress as an input parameter to the comment of a cell at its cellAddress.
' Add a comment.
Set ImageCommentContainer = Application.ActiveCell.AddComment
' With the comment, set parameters.
With ImageCommentContainer
.Text Text:=""
'With the shape overlaying the comment, set parameters.
With .Shape
.Fill.UserPicture (cellAddress.Value)
.ScaleHeight 3#, msoFalse, msoScaleFormTopLeft
.ScaleWidth 2.4, msoFalse, msoScaleFromTopLeft
End With
End With
InsertImageCommentAsWorkAround = title
End Function
I would advise adapting the comment sets into your loop, and use that to set your images into place, using the shape formatting in your loop to set the formatting of the comment shapes generated by the adapted code.