Excel VBA: How do I delete images in a specific range - vba

I have a macro that imports data from a selected file. The data includes some images. The problem I am having is if i have data and images already in my document, and I go to import new data, the images do not delete and simply get pasted on top of each other. I wrote code to select the cells and clear them, but it doesn't clear the images.
I think the solution is to put some code at the beginning that can select the images in the cell range and delete them, before the new data is imported.
I came across a solution that Selects all images in the worksheet and deletes them, But I have other images that I need to keep.
Is is possible to tell it to select all images in a specific range of cells?

A quick Google search (most questions have been asked in one place or another) came up with this result. It uses the TopLeftCell and BottomRightCell attributes of Excel Picture objects, then checks if it is inside the range.
Sub test()
'Code by Peter T from https://www.excelbanter.com/excel-programming/404480-select-delete-all-pictures-given-range.html
Dim s As String
Dim pic As Picture
Dim rng As Range
' Set ws = ActiveSheet
Set ws = ActiveWorkbook.Worksheets("Sheet2")
Set rng = ws.Range("A5:C25")
For Each pic In ActiveSheet.Pictures
With pic
s = .TopLeftCell.Address & ":" & .BottomRightCell.Address
End With
If Not Intersect(rng, ws.Range(s)) Is Nothing Then
pic.Delete
End If
Next
End Sub
I have not tested this code, but even so it should provide you with enough information to adjust your own code.

Thanks. I too came across this but was having issues with it. With more research, I was able to get this code to do what I wanted it to,
Sub DeleteImage()
Dim pic As Picture
ActiveSheet.Unprotect
For Each pic In ActiveSheet.Pictures
If Not Application.Intersect(pic.TopLeftCell, range("H10:R24")) Is Nothing Then
pic.Delete
End If
Next pic
End Sub

Related

Keeping multiple bookmarks when filling form

I'm trying to create a userform that will add text to the Word document based on a mixture of inputs coming from the userform. It could be checkboxes, lists, or textboxes where one writes content. As I was looking around for codes to preserve the bookmarks that I use to transfer the inputs into Word text, I came across one that allowed me to successfully preserve the bookmark for future editing. I thought I could use the same method for multiple bookmarks, but it seems not to work. With an example, now.
I have TextBox1, TextBox2 (in the userform), Bookmark1, Bookmark2 (in the Word document), and CommandButton1 to give the ok to transfer info from the userform to the Word document. I want to make TextBox1's content appear where Bookmark1 is, and TextBox2's content where Bookmark2 is. Code I tried is:
Private Sub CommandButton1_Click()
Dim BMRange01 As Range
Set BMRange01 = ActiveDocument.Bookmarks("Bookmark1").Range
BMRange01.Text = Me.TextBox1.Value
ActiveDocument.Bookmarks.Add "Bookmark1", BMRange01
Dim BMRange02 As Range
Set BMRange02 = ActiveDocument.Bookmarks("Bookmark2").Range
BMRange02.Text = Me.TextBox2.Value
ActiveDocument.Bookmarks.Add "Bookmark2", BMRange02
End Sub
When I tried with a single bookmark (from the first "Dim" to the last BMRange01) it worked just fine, and I could edit and re-use the bookmark multiple times. When I try with two of them, however, only one of them is preserved (or rather, deleted and created back again). Specifically, the second one seems to be preserved, while the first one (Bookmark1) is deleted.
Make your life a bit easier and create a separate sub to handle the work. Eg:
Private Sub CommandButton1_Click()
ReplaceBookmarkText ActiveDocument, "Boomark1", me.TextBox1.Value
ReplaceBookmarkText ActiveDocument, "Boomark2", me.TextBox2.Value
End Sub
Sub ReplaceBookMarkText(doc As Document, bmName As String, txt)
Dim rng As Range
Set rng = doc.Bookmarks(bmName).Range
rng.Text = txt
doc.Bookmarks.Add bmName, rng
End Sub

Copy as Picture Returns Run Time Error 1004 everytime

I create a new excel file I create two tabs. I record a macro where I select a range of cells (Does not matter the size) on Sheet1 then select copy as picture. I then paste that image on Sheet 2. I stop the recording and delete the image and go back to Sheet 1. I then try to play the macro and i get Runtime Error 1004. Does Anyone know how to fix my excel?
I am happy to share my code but did not think it was necessary sense it seems to be more a core problem in excel.
Adding Code Below.
Sub CopyData(tRange As String, SheetName As String)
Worksheets(SheetName).Range(tRange).CopyPicture xlPrinter, xlPicture
End Sub
Sub Test()
Call CopyData("B2:I31", "Sheet1")
End Sub
Adding new Details
In my office we have 4 macs. All of them had started requesting updating to excel 16.11.1 . This had been done on two mine and One other computer. Today I tried my code on one of the machines that does not have 16.11.1 and it worked. I updated to 16.11.1 and it stopped working. I feel confident that 16.11.1 is the problem.
This will accomplish what you are trying to do; set your worksheets and ranges as variables. You do not need to add the constants for CopyPicture if you will be using the defaults, which are: xlScreen and xlPicture...
Sub CopyData()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Rng1 As Range
Dim Rng2 As Range
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set Rng1 = ws1.Range("B2:I31")
Set Rng2 = ws2.Range("A1") 'change the cell ref as needed
Rng1.CopyPicture xlPrinter, xlPicture
ws2.Paste Destination:=Rng2
End Sub
The Issue was caused by office being update. I followed Microsofts instructions for downgrading and it solved the issue. Thanks to all those who responded and gave support.

Extract hyperlink target from a cell in different workbook

I have a workbook with a custom right click function that extracts cell values from another workbook depending on what the user chooses. It works very well, I just take in the cell's value from the other workbook. Some cells contain hyperlinks though, and I'd like to import the functional hyperlink, not the value of what's shown in the cell. For example, the following image contains a hyperlink in cell (Y216) of sheet BOS of the input workbook.:
This is an image of the cell I want to copy. It is indeed a hyperlink.
?application.Workbooks(2).Sheets("BOS").Range("Y216").value
returns MKB 70-203 Wicket Shear Pin Detection System, which is indeed correct.
But how do I take the hyperlink's destination? I tried several things including
?application.Workbooks(2).Sheets("BOS").Range("Y216").Hyperlinks.count
returns 0 even though you can see in the image that the hyperlink does have an address. In the same fashion the following sub doesn't enter the For Each because it counts 0 hyperlinks.
Sub HLtester()
Dim HL As Hyperlink
For Each HL In Application.Workbooks(2).Sheets("BOS").Range("Y216").Hyperlinks
Debug.Print HL.Address
Next
End Sub
Expected output would be the link's target J:\SOUM\3191.... as shown in image.
EDIT
If it's important the cell's formula is
=LIEN_HYPERTEXTE("J:\SOUM\3191 M - Old Hickory Dam\11_BOS_FT\02_FT_MECT\21-200 Headcover";"21-200 Headcover")
That's the =HYPERLINK function of French Excel, by the way. I guess in last resort I can take the formula and cut off the function parts to retrieve the link part?
Your command works for me, I don't know why you set the range if you want to loop through all the hyperlinks in the sheet -neither why you set as application. workbooks-, anyways, this worked fine for me:
Sub HLtester()
Dim HL As Hyperlink
For Each HL In Sheets("Sheet1").UsedRange.Hyperlinks
Debug.Print HL.Address
Next
End Sub
You may get it as well within range methods with the following
ActiveCell.Hyperlinks(1).Address
You may get more info here
Edit:
Probably the count is wrong because of the "application.workbook", try to declare it as a variable instead of using it all over the code
Sub HLtester()
Dim HL As Hyperlink
Dim WBAnalyzed As Workbook: Set WBAnalyzed = Workbooks("MyWB.xlsm")
For Each HL In WBAnalyzed.Sheets("Sheet1").UsedRange.Hyperlinks
Debug.Print HL.Address
Next
End Sub
Edit 2:
This is the approach suggested when the hyperlink it's given by its formula
Sub test()
On Error Resume Next 'means no formula
x = Evaluate(Range("A1").Formula)
x1 = Sheets("Sheet1").UsedRange.Hyperlinks.Count
Debug.Print x
Debug.Print x1
End Sub
PS: I saved my variable declaration -just cause-, but, you should always have a neat control for them and use option explicit at the beginning of the module.

Show picture upon cell selection that matches cell string to picture database in excel

I will attempt to explain to the best of my abilities what I am looking for as far as a final product. I am trying to make a spreadsheet that has a list of strings in a column.
When the strings are hovered over, the string will be used to match to the name of a picture in a database. The database will return the picture and show it as a rollover image.
I have searched for ways on how to do this, but I keep finding people who change it based on the comments and use a static image for each cell. I have a database of around 23000 pictures and can't do it manually one at a time, and the cells have the potential to be variable depending on the opened sheets.
Hover over is not necessary, however. I would be more than happy to do this upon a cell selection.
This is a broad question and covers many parts. Here is a little something to get you started.
Open the VB Editor by pressing Alt+F11. Right click on the sheet you want this functionality to exist on and then click View Code. This code will load a comment with a single image (be sure to change C:\YOUR_IMAGE_FULL_PATH to a valid image) into whichever cell you click into. When you leave the cell it will delete the comment.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
Static cellAddress
Dim sFile As String
Dim cmt As Comment
If cellAddress <> "" Then
Set cmt = Range(cellAddress).Comment
cmt.Delete
Set cmt = Nothing
End If
sFile = "C:\YOUR_IMAGE_FULL_PATH"
Set cmt = Target.AddComment
cmt.Text Text:=""
With cmt.Shape
.Fill.UserPicture sFile
End With
cellAddress = Target.Address
End If
End Sub
When you say
The database will return the picture and show it as a rollover image
Does that mean the image itself is stored in the database? Or is the name of the image returned from the database and we have to search a directory on the HDD for an image with that name?
Without knowing your DBMS or your table schema or anything like that I can't really help much more.

Making excel graphs appear/disappear

I want a graph only to appear when a condition is fulfilled. To be more precise: I have a drop down menu that changes the content of a graph. If the menu point "Total revenue" is clicked, I want a second graph to appear. I am new to VBA and this is what I came up with so far:
Sub Iffuntion()
Dim SelectedChart As Range
Dim notVisible As Boolean
If Range("D100").Value = Range("E100").Value Then
ActiveSheet.ChartObjects("Testchart").Visible = True
Else
ActiveSheet.ChartObjects("Testchart").Visible = notVisible
End If
End Sub
It works, but I have to execute the VBA to make the graph appear/disappear and I would like that to happen automatically. Also the condition should eventually be in another worksheet to keep the sheet with the graphs nice and tidy. I read that to achieve this I have toI have to activate the other worksheet. Would you recommend this way or is there a better solution?
Thanks for the help and best regards!
Pete
EDIT: Here is the link to a sample file with the proposed solution of Cor_Blimey, that I couldn't get to work properly. The interconnections in the excel are more complicated than they would have to be, but I wanted to be as accurate ad possible in displaying what is actually happening in my excel. Thanks for taking a look!
https://dl.dropboxusercontent.com/u/18406645/sample.xlsm
Assuming you mean that they change, from a data validation drop down list, the contents of a cell then you can put your code into the Worksheet's Worksheet_Change event. This event is fired when the user changes the content of a cell (or by an external link).
Then test for the cell being the right cell then run your code.
Like:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Target, Me.Range("D100"))
If Not rng Is Nothing Then
If rng.Value = Me.Range("E100").Value Then
Me.ChartObjects("Testchart").Visible = True
Else
Me.ChartObjects("Testchart").Visible = False
End If
End If
End Sub