I have a set of shapes, which can be deleted.
However if at least one of them is deleted, then I am getting an error, that the object under the specified name wasn't found.
Basically I would like to make a comment after all, informing me, that all of the shapes have been already deleted.
My code looks like this so far:
Sub Civremov()
ActiveSheet.Shapes("Tobyshape").Delete
ActiveSheet.Shapes("Toby").Delete
ActiveSheet.Shapes("Upturnshape").Delete
ActiveSheet.Shapes("Upturndesc").Delete
ActiveSheet.Shapes("Duct1").Delete
ActiveSheet.Shapes("Duct2").Delete
End Sub
Now, when I attempt to delete these elements again, the errors says, that the object under a specified name wasn't found.
I would like to make a textbox like this:
Msgbox("You have already deleted all civil features").
How can I do this?
You could catch an error, however personally I usually like to loop over shapes, check their properties (name in your case) and act accordingly. You could opt to delete shapes when their name is found in a certain array of names?
For example:
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("YourSheetName")
Dim arr As Variant: arr = Array("Tobyshape", "Toby", "Upturnshape", "Upturndesc", "Duct1", "Duct2")
For Each shp In ws.Shapes
If IsNumeric(Application.Match(shp.Name, arr, 0)) Then
shp.Delete
End If
Next
Msgbox "All relevant shapes are deleted." 'Optional
End Sub
If we are speaking of a certain type of shape, you could also include that check into your For loop to minimize the times we call Application.Match
Related
I would like to delete all the shapes from my sheet. They have the same ID.
I found two codes:
The first one:
Public Sub ActiveShapes()
Dim ShpObject As Variant
If TypeName(Application.Selection) = "Firestop" Then
Set ShpObject = Application.Selection
ShpObject.Delete
Else
Exit Sub
End If
End Sub
is not working. There are no errors, but also no reaction at all.
The second one:
Selecting a shape in Excel with VBA
Sub Firestopshapes()
ActiveSheet.Shapes("Firestop").Delete
End Sub
works, but remove only one by one element. In my event, all the elements have the "Firestop" ID. I would like to make them all deleted at once. How can I do that?
The issue is thet If TypeName(Application.Selection) = "Firestop" Then is never true. Have a look into the TypeName function does not return the name of the Application.Selection but instead it returs what type Application.Selection is. Here it probably returns Object because a shape is an object.
Actually names are unique. You cannot add 2 shapes with the same name. That is why ActiveSheet.Shapes("Firestop").Delete only deletes one shape.
There seems to be a bug that when you copy a named shape 2 shapes with the same name exist (which should not be possible). You can get around this by deleting that shape in a loop until you get an error (no shape with that name is left).
On Error Resume Next
Do
ActiveSheet.Shapes("Firestop").Delete
If Err.Number <> 0 Then Exit Do
Loop
On Error GoTo 0 'don't forget this statement after the loop
It is not recommended to use On Error Resume Next often. We recommend using it only when it is indispensable.
Sub test()
Dim shp As Shape
Dim Ws As Worksheet
Set Ws = ActiveSheet
For Each shp In Ws.Shapes
If shp.Name = "Firestop" Then
shp.Delete
End If
Next shp
End Sub
I'm not a regular user of vba, so when I started doing this code I was totally blank. I already deleted all the images on the worksheet, including command buttons and a logo I didn't meant to delete.
This is my code
Private Sub CommandButton2_Click()
Dim Pic As Object
Range("D20:D3000").ClearContents
For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic
End Sub
As you can see I need it to delete the images on the D column, but it deletes the images of the whole sheet.
I can't find a way to exclude command buttons (I'm using 2 on that sheet) of the deleting instruccion. Would some of you please, please, please help me? I'm a mess right now.
I need it to delete the images on the D column, but it deletes the images of the whole sheet.
You are iterating all pictures on the sheet, and never verify where on the sheet the picture is before you invoke its Delete method.
Interestingly, if you have one picture and one ActiveX command button on Sheet1, then Sheet1.Pictures.Count returns, unexpectedly, 2 - that's why the loop is also deleting command buttons.
I'd suggest iterating the Shapes collection instead: a Shape object has an interface that makes it much easier to tell a picture apart from an ActiveX button, ...and to know where on the sheet it's at.
Using Shape.Type we can know if we're looking at a msoPicture, and with Shape.TopLeftCell we can get a Range object representing the top-left cell the picture is located at; if the Column of that Range is 4, then we're looking at a shape whose upper-left corner is located in column D. Thus:
Dim currentShape As Shape
For Each currentShape In ActiveSheet.Shapes
If currentShape.Type = msoPicture And currentShape.TopLeftCell.Column = 4 Then
currentShape.Delete
End If
Next
Note how declaring an explicit type that isn't Object for our loop variable, we get compile-time validation, and autocomplete/intellisense for every single one of these member calls, whereas calls made against Object are all late-bound (i.e. compiles perfectly fine with typos, even if you have Option Explicit at the top of your module) and will only blow up at run-time if anything is wrong (e.g. error 438 if you try to invoke a member that doesn't exist).
The following compares the picture's range with your range and deletes it if they intersect:
Private Sub CommandButton2_Click()
Dim objPicture As Object
Dim objPictureRange As Object
Dim objRange As Object
Set objRange = Range("D20:D3000")
objRange.ClearContents
For Each objPicture In ActiveSheet.Pictures
' Get Picture's range
Set objPictureRange = Range(objPicture.TopLeftCell.Address & ":" & objPicture.BottomRightCell.Address)
' Check if Picture is in Range
If Not Intersect(objRange, objPictureRange) Is Nothing Then
' Delete picture
objPicture.Delete
End If
Next Pic
End Sub
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 :)
so I have been searching through this forum for quite a while now, and also on other sites, but I just could not find a way to solve this problem.
So the small problem I got is, that I have a very long Excel Spreadsheet, with many different ID's, or numbers whatever you want to call them. From these ID's I create a custom link, which needs them to direct to a specific image, that is then pasted into a specific cell in this spreadsheet. Note that I really need this code, hence the spreadsheet is about 9300 lines/rows long. The problem now is that not every id has an image attached to it, which means that some links do not work (no image there, but also no text basically an empty page). Is there a way I can just let the code run through it, so that it ignores the error 1004 which is generated, which basically is always telling me he could not find something and will stop at that point.
I am a big noob at VBA, so please when answering do not use to complicated language. I will paste the code below, however the link is confidential, so I will replace the link with "link" or something like that. I tried several On Error methods, but either the error came up again, or Excel crashed, but here is the working code without any modifications to remove this error. Thanks in advance for all the help.
Sub Test()
I = 0
For I = 5 To 9373
If Tabelle2.Cells(I, 9) = "bekannt" Then
Call GetShapeFromWeb("Part 1 of the link" & Tabelle2.Cells(I, 10).Value & "Part 2 of the link", Tabelle2.Cells(I, 13))
End If
Next I
End Sub
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
With rngTarget
With .Parent
.Pictures.Insert strShpUrl 'Error Occurs here
Set shp = .Shapes(.Shapes.count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Set shp = Nothing
End Sub
One last thing to notice, some of the words are german, due to me being german and working with german variables, or links, or spreadsheets. And I am using excel 2007. The Error occurs in the following row ".Pictures.Insert strShpUrl" because it can not find a picture to insert.
Thansk a lot.
Kind Regards
Chris
//EDIT
One Idea I might have, which I dont know if it is possible, but the page it is directed to, when a picture is not there it displays the following "Unable to find /part/of/thelink/"
Could one maybe use a code to see if this message is displayed, and maybe check for that? If so how would that work? :) Maybe it could be added to the if statement at the top which tests already for this sub task.
//EDIT
Anyone got some idea? :S Maybe what I posted above in the edit could work? :S Is it possible to check if a msgbox displays something but the other way around so if the msgbox does not equal the following do this. If that could work it would be great! :S Or maybe instead of trying the on error commands trying it with an if statement within the GetShapeFromWeb sub? Any help is greatly appreciated.
This should work. However you wrote that you tried several On Error Methods unsuccessfully ... what does this one for you?
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
Dim Er As Long: Er = 0
On Error GoTo gswError
With rngTarget
With .Parent
.Pictures.Insert strShpUrl
If Er <> 0 Then Exit Sub
Set shp = .Shapes(.Shapes.Count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Set shp = Nothing
Exit Sub
gswError:
Er = Err
Resume Next
End Sub
have you tried on the GetShapeFromWeb sub, placing the On Error statement this way:
Sub GetShapeFromWeb(strShpUrl As String, rngTarget As Range)
Dim shp As Shape
On Error GoTo Err1 'inserting a picture from a blank link will cause an error... thus...
With rngTarget
With .Parent
.Pictures.Insert strShpUrl
Set shp = .Shapes(.Shapes.Count)
End With
shp.Left = .Left
shp.Top = .Top
End With
Err1: '...sidestep
Set shp = Nothing
End Sub
I have two spreadsheets... when one gets modified in a certain way I want to have a macro run that modifies the second in an appropriate manner. I've already isolated the event I need to act on (the modification of any cell in a particular column), I just can't seem to find any concrete information on accessing and modifying another spreadsheet (this spreadsheet is located on a different LAN share also... the user has access to both, though).
Any help would be great. References on how to do this or something similar are just as good as concrete code samples.
In Excel, you would likely just write code to open the other worksheet, modify it and then save the data.
See this tutorial for more info.
I'll have to edit my VBA later, so pretend this is pseudocode, but it should look something like:
Dim xl: Set xl = CreateObject("Excel.Application")
xl.Open "\\the\share\file.xls"
Dim ws: Set ws = xl.Worksheets(1)
ws.Cells(0,1).Value = "New Value"
ws.Save
xl.Quit constSilent
You can open a spreadsheet in a single line:
Workbooks.Open FileName:="\\the\share\file.xls"
and refer to it as the active workbook:
Range("A1").value = "New value"
After playing with this for a while, I found the Michael's pseudo-code was the closest, but here's how I did it:
Dim xl As Excel.Application
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open "\\owghome1\bennejm$\testing.xls"
xl.Sheets("Sheet1").Select
Then, manipulate the sheet... maybe like this:
xl.Cells(x, y).Value = "Some text"
When you're done, use these lines to finish up:
xl.Workbooks.Close
xl.Quit
If changes were made, the user will be prompted to save the file before it's closed. There might be a way to save automatically, but this way is actually better so I'm leaving it like it is.
Thanks for all the help!
Copy the following in your ThisWorkbook object to watch for specific changes. In this case when you increase a numeric value to another numeric value.
NB: you will have to replace Workbook-SheetChange and Workbook-SheetSelectionChange with an underscore. Ex: Workbook_SheetChange and Workbook_SheetSelectionChange the underscore gets escaped in Markdown code.
Option Explicit
Dim varPreviousValue As Variant ' required for IsThisMyChange() . This should be made more unique since it's in the global space.
Private Sub Workbook-SheetChange(ByVal Sh As Object, ByVal Target As Range)
' required for IsThisMyChange()
IsThisMyChange Sh, Target
End Sub
Private Sub Workbook-SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
' This implements and awful way of accessing the previous value via a global.
' not pretty but required for IsThisMyChange()
varPreviousValue = Target.Cells(1, 1).Value ' NB: This is used so that if a Merged set of cells if referenced only the first cell is used
End Sub
Private Sub IsThisMyChange(Sh As Object, Target As Range)
Dim isMyChange As Boolean
Dim dblValue As Double
Dim dblPreviousValue As Double
isMyChange = False
' Simple catch all. If either number cant be expressed as doubles, then exit.
On Error GoTo ErrorHandler
dblValue = CDbl(Target.Value)
dblPreviousValue = CDbl(varPreviousValue)
On Error GoTo 0 ' This turns off "On Error" statements in VBA.
If dblValue > dblPreviousValue Then
isMyChange = True
End If
If isMyChange Then
MsgBox ("You've increased the value of " & Target.Address)
End If
' end of normal execution
Exit Sub
ErrorHandler:
' Do nothing much.
Exit Sub
End Sub
If you are wishing to change another workbook based on this, i'd think about checking to see if the workbook is already open first... or even better design a solution that can batch up all your changes and do them at once. Continuously changing another spreadsheet based on you listening to this one could be painful.