Insert picture to Excel VBA, method Pictures failed - excel

Tried to make a macro that progressively inserts 3 images in Excel
One worksheet (pics) contains the URLs of images in Column A row 1-3
The other worksheet (outputs) is supposed to output the images horizontally.
Sub testinsertpix()
Dim i As Integer
Dim link As String
For i = 1 To 3
link = Worksheets("pics").Cells(i, "A").Value
Cells(1, i).Select
ActiveSheet.Pictures.Insert (link)
Next i
End Sub
It does insert the first image, but fails when the loop reaches the 2nd picture.
"Insert method of Pictures class failed"
Little help please?

Try:
Dim link as Variant
Then output the value and see where it's going wrong. My best guess is your URL isn't being read the way you'd expect.

I have a similar macro and I had the same error.
For me this helped: On error resume next
Sub INSERTPICTURES()
With Sheets("Condition_report")
Dim cella As Range
For Each cella In .Range("A1:A10000").Cells
If cella.Interior.ColorIndex = 3 Then
ActiveSheet.Shapes.AddPicture Filename:=cella, LinkToFile:=msoFalse, SaveWithDocument:=msoCTrue, Left:=cella.MergeArea.Left, Top:=cella.MergeArea.Top, Width:=cella.MergeArea.Width - 3, Height:=cella.MergeArea.Height
On Error Resume Next
End If
Next
End With
End Sub

Related

Can I dynamically count the number of times I reset an Excel Sheet?

Currently I have a reset button for my excel sheet which will clear the contents except the formulas I have. Is there a way to dynamically count how many times I "pressed" the reset button and clear contents?
This..
Public countR As Long
Sub Alternative1() 'This will return to 0 when you close the workbook
countR = countR + 1
MsgBox "The document has been cleared " & countR & " time(s)"
End Sub
or..
Sub Alternative2()
Dim rng As Range
Set rng = Range("A1") 'Change to some cell that isn't cleared by your code
rng.Value = rng.Value + 1
End Sub
and call them like..
Sub WhatYourCodeMaybeLooksLike()
Range("B1:C100").ClearContents
Alternative1
Alternative2
End Sub
The comment by reportgunner above is correct, but if you're asking for VBA options then look at module level variables.
Public x As Integer
Sub Button1_Click()
x = x + 1
MsgBox x
End Sub
x will begin as 0 when you open the workbook and will then be incremented each time Button1 is hit, in this case.
Slightly different are static variables which you can declare in the procedure with the code. Both will work fine in VBA.
The variable will often reset if your code hits errors during debugging. So the cell option might be preferable if you never want to lose track of the number.

Excel VBA error 1004 when trying to delete buttons from a range of cells

I'm having issues with deleting a range of cells that contains ActiveX command buttons in it, as the code below will throw an error 1004 "Application-defined or object-defined error" on the intersect part when debugging.
Sub DeleteShapes()
Dim rng As Range
Dim sh As Shape
Set rng = Range("I7:K61")
With Sheets("ADB")
For Each sh In .Shapes
If Not Intersect(sh.TopLeftCell, .Range(rng)) Is Nothing Then
sh.Delete
End If
Next
End With
End Sub
The sheet is not locked, and I made sure that all cells within the ranges are not locked as well. No merged cells too. I've tried other combinations of codes, but it still results in that error 1004. The code is in a module.
Strange thing is, if I add a code to ignore the error, it deletes the buttons without issues. However, a strange issue popped up, wherein the dropdown box from data validations fail to show up after deleting the buttons. The only way for it to show up is to save the workbook. Deleting the buttons after saving causes the disappearance of the dropdown again.
Any solutions to this?
EDIT: It looks like I'm experiencing some sort of "Phantom drop down" object with Type 8 based on VBasic2008's code. I've created a new sheet and tried to copy some of the old ones, then it persisted again.
Further experimentation shows that it's coming from my Data Validation cells. Yet strangely enough, removing the data validation doesn't remove the drop down object. Clearing the entire sheet causes the object to still persist. I had to delete the sheet to get rid of it..
Is Data Validation being considered a Form Control? It shouldn't be.. right?
EDIT: How I generate my buttons
Public Sub GenerateButtons()
Dim i As Long
Dim shp As Object
Dim ILeft As Double
Dim dblTop As Double
Dim dblWidth As Double
Dim dblHeight As Double
Dim lrow As Long
lrow = Cells(Rows.count, 1).End(xlUp).Row
With Sheets("ADB")
ILeft = .Columns("I:I").Left
dblWidth = .Columns("I:I").Width
For i = 7 To lrow
dblHeight = .Rows(i).Height
dblTop = .Rows(i).Top
Set shp = .Buttons.Add(ILeft, dblTop, dblWidth, dblHeight)
shp.OnAction = "Copy1st"
shp.Characters.Text = "Copy " & .Cells(i, 6).Value
Next i
End With
End Sub
Shapes
In VBE's object browser search for msoShapeType and you will notice that
there are several shape types. In your case probably:
msoFormControl (8) - Drop downs
msoOLEControlObject (12) - Buttons and stuff.
Anyway try this code first to determine what you want to delete.
Sub ShapeTypes()
Dim shshape As Shape
Const c1 = " , "
Const r1 = vbCr
Dim str1 As String
str1 = "Shape Types in ActiveSheet"
For Each shshape In ActiveSheet.Shapes
str1 = str1 & r1 & Space(1) & shshape.Name & c1 & shshape.Type
Next
Debug.Print str1
End Sub
The following code deletes all msoOLEControlObject typed shapes on the ActiveSheet (Which I am assuming you want to delete):
Sub ShapesDelete()
Dim shshape As Shape
For Each shshape In ActiveSheet.Shapes
If shshape.Type = 12 Then
shshape.Delete
End If
Next
End Sub
Finally your code:
Sub DeleteShapes()
Const cStrRange As String = "I7:K61"
Const cStrSheet As String = "ADB"
Dim sh As Shape
With Sheets(cStrSheet)
For Each sh In .Shapes
If sh.Type = 12 Then 'or msoOLEControlObject
On Error Resume Next
If Intersect(sh.TopLeftCell, .Range(cStrRange)) Then
If Not Err Then
sh.Delete
End If
End If
End If
Next
End With
End Sub
I still haven't figured out the reason behind the error, but it is handled and all the buttons get deleted.
New Version:
Sub DeleteShapes()
Const cStrRange As String = "I7:K61"
Const cStrSheet As String = "ADB"
Dim sh As Shape
With Sheets(cStrSheet)
For Each sh In .Shapes
If sh.Type = 8 Then 'or msoFormControl
On Error Resume Next
If Not Intersect(sh.TopLeftCell, .Range(cStrRange)) Is Nothing Then
If Left(sh.Name,4) = "Butt" then
sh.Delete
End If
End If
End If
Next
End With
End Sub
No need for error handling since the WRONG Intercept line was causing the error.

VBA - Value of an option button in a frame (within an Excel sheet)

I'm having problems with shapes, frames and option buttons... I'm a total newbie, I've never used them. I just put several option buttons on an Excel sheet (Using the FORM toolbox).
I'm trying to check whether my optionbutton is filled or not. So far, I've done the following :
Sub SX_EXTERNE()
Dim Ws As Worksheet
Dim ConBut As Shape
Dim Answer As String
Set Ws = ThisWorkbook.Sheets("Externe")
For Each ConBut In Ws.Shapes
If ConBut.Type = msoFormControl Then
If ConBut.FormControlType = xlOptionButton Then
If ConBut.ControlFormat.Value = xlOn Then
Answer = ConBut.Name
End If
End If
End If
Next ConBut
MsgBox Answer
End Sub
My problem is I do not know how to check only in a selected frame (i.e. "Conges_generaux" for my example):
Could you please give me a hint? I've seen many subjects about that but many of them treat of ActiveXControls... I don't even know the difference.
Thanks
Here is a quick way
Sub Sample()
Dim optBtn As OptionButton
For Each optBtn In ActiveSheet.OptionButtons
If optBtn.Value = 1 Then
Debug.Print optBtn.Name
Debug.Print optBtn.GroupBox.Name
End If
Next
End Sub
So in your code change Dim ConBut As Shape to Dim ConBut As OptionButton. Feel free to put relevant checks and store it in the relevant answer variable :)

When looping over shapes in a document I get only Comment types even though it has many drop down menues

I have a file that someone made and I was tasked with simply adding an autoupdater function that updates the cell next to the dropdown menu.
The way the dropdown menu is created is by going to data validation and selecting list and make list in cell. The values are read from elsewhere.
Now, what I tried was to loop over all shapes like this:
Dim dd As DropDown
Dim i As Integer
Debug.Print Sheet1.DropDowns.Count
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim s As Shape
For Each s In ws.Shapes
Debug.Print CStr(s.Type)
Next
Next
End Sub
This prints the following:4 is a comment, 8 is a control form
444444444444444444444444444
8
So even though I have many drop down menus none come out when I loop over them.
I wanted to make it so that anyone can add a dropdown box and my code would attach an OnAction Sub that fills in the cell next to the dropdown box so the user can add as many boxes they want, but they have to only remember to keep the cell next to it, to the right for example, empty as it will be overridden.
Dim sh As Shape
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
For Each sh In ws.Shapes
If sh.Type = msoFormControl Then
If sh.FormControlType = xlListBox Then
sh.OLEFormat.Object.OnAction = "UpdateLBCell"
End If
End If
Next
Next
The original code above causes an object error on the innermost line.
Am I just stupid or is it not possible to loop over these dropdown boxes?
If it is impossible, can I make some other dropdown single select boxes that fit inside a cell? Combobox I tried, but they lie on top and dont match.
Any insight in alternative ways to do this is very appreciated as well.
I put a list validation on a few cells, then ran this code
Sub Test()
Dim dd As DropDown
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
Dim s As Shape
For Each s In ws.Shapes
Debug.Print CStr(s.Type), s.Top, s.Left
s.Visible = msoCTrue '<<<<
Next
Next
End Sub
Before and after (yellow cells have data validation):
So it seems as though if you have a "list" data validation set up, Excel manages a single (normally invisible and empty) drop-down which is typically positioned at the current active cell. It's only made visible when that's also one of the cells with validation set up.
EDIT: here's an example of how you could handle updates to cells with drop-down DV lists in a generic way -
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
On Error GoTo haveError
Application.EnableEvents = False
For Each c In Target.Cells
If HasDVList(c) Then
c.Offset(0, 1) = Now
End If
Next c
haveError:
Application.EnableEvents = True
End Sub
'does a cell have DV list?
Function HasDVList(rng As Range)
Dim v
On Error Resume Next
v = rng.Cells(1).Validation.Type
On Error GoTo 0
HasDVList = (v = 3)
End Function
The Shape should be Visible, whether the cell is "clicked-on" or not. I put a single DV dropdown on a sheet and ran:
Sub ShapeLister()
Dim s As Shape
For Each s In ActiveSheet.Shapes
MsgBox s.Type & vbCrLf & s.Name
Next s
End Sub
and got:
Try this on a fresh worksheet and tell us what you see.

Check box general selector and macro to show next three rows when one checkbox is selected

I am new to macros so I'm not sure this is possible in VBA.
I am trying to create a document where is composed with many mini tables made of 4 rows.
One row is the title which have a checkbox and will always be shown and three rows below where contains data that I only what to see when I select the relevant checkbox.
This document will have many mini tables hence many check boxes and I was wondering if there is a generic selector for checkboxes where I can apply the same macro.
I have seen the following macro, but this will apply only to one check box and I was wondering if there was a way to apply one for all checkboxes saying that if checkbox in row 4 is selected then show row 5,6 and 7. If checkbox in row 8 is selected then show rows 9,10,and 11 and so on....
Private Sub CheckBoxRow4_Click()
Rows("5:6:7").Hidden = CheckBoxRow4.Value
End Sub
See screenshot for a better idea.
It would also be appreciated if you could indicate how can I get those three rows below hidden by default when opening the document.
I am using Excel 2011 for Mac if that makes any difference.
Thank you in advance.
I'm sure there will be several approaches to this. My first thought goes to adding checkboxes, linking them all to a single macro. When activated, you have to do several things:
find out who is calling the sub (which checkbox);
find out where that specific checkbox is located (which row);
hide / unhide the rows below it.
1:
The name of the checkbox is easy. Application Caller will give you that.
2:
Location is the real problem here. I don't see a simple solution here, other then giving the checkboxes such specific names, that it is clear which row it is in. If you add a checkbox, you can give the name in the 'named range' inputfield. If you give it names that will specify the rows it must hide, it is even better. So something like:
HIDE_4_7 would indicate the checkbox must hide / unhide rows 4 to 7.
3:
Hiding the rows is now easy.
total solution:
Sub HideRows()
Dim cbName As String
Dim cbValue As Boolean
Dim s() As String
Dim firstRow As Long
Dim lastRow As Long
On Error Resume Next
cbName = Application.Caller
If Err.Number <> 0 Then Exit Sub 'sub is not called from an application object
cbValue = (ActiveSheet.CheckBoxes(cbName) = xlOn)
If Err.Number <> 0 Then Exit Sub 'sub is not called from a checkbox
On Error GoTo 0
s = Split(cbName, "_")
If s(LBound(s)) <> "HIDE" Then Exit Sub 'name of the shape is not valid
firstRow = Val(s(LBound(s) + 1))
lastRow = Val(s(LBound(s) + 2))
Sheets(1).Rows(firstRow & ":" & lastRow).Hidden = Not cbValue
End Sub
You would have to call the checkboxes HIDE_*firstrow*_*lastrow*, and link them to this sub. That works on my side.
EDIT
To hide all rows on opening, you could use the Workbook_Open sub (in the workbook code storage thingy). Something like this:
Private Sub Workbook_Open()
Dim shp As Shape
Dim s() As String
Dim firstRow As Long
Dim lastRow As Long
Dim cbValue As Boolean
For Each shp In Sheets(1).Shapes
Debug.Print shp.Name
s = Split(shp.Name, "_")
If s(LBound(s)) <> "HIDE" Then GoTo nextShp
'set checkbox off:
Sheets(1).CheckBoxes(shp.Name) = xlOff
firstRow = Val(s(LBound(s) + 1))
lastRow = Val(s(LBound(s) + 2))
Sheets(1).Rows(firstRow & ":" & lastRow).Hidden = True
nextShp:
Next shp
End Sub

Resources