I have added my macro to my toolbar and would like to put some sort of basic check on it. Instead of asking the user whether he wants to perform the macro, I would like to check the document for a certain image that is always in the documents the macro is used for. (other suggestions are welcome too)
ActiveSheet.Shapes.Range(Array("Picture -767")).Select
That's the code I use to select the image. I haven't been able to find out how to manage an image. What I'm trying to do is
If Image is found then
Part1
Part2
Else
MsgBox 'Macro is not intended for this document'
End if
All help is appreciated!
This should work:
Option Explicit
Sub PicTest()
Dim Shp As Shape
On Error GoTo ErrorExit
Set Shp = ActiveSheet.Shapes("Picture -767")
On Error GoTo 0
ActiveSheet.Shapes.Range(Array("Picture -767")).Select
Part1
Part2
Exit Sub
ErrorExit:
MsgBox "Macro is not intended for this sheet"
End Sub
Related
I want to use VBA code to pull up my form. Right now the code is causing a runtime error on Sub UserForm_Initilize(). I don't know a lot about VBA. I know I might need to do something like column.selectAll but I am not sure assume I am trying to select the first 4 columns for my form. Thanks
Sub UserForm_Initialize()
Me.TextBox1.Value = Sheet1.Range("H" & Rows.Count).End(xlUp).Value
End Sub
Sub Rectangle1_Click()
UserForm1.Show
End Sub
I've created a drop down menu through data validation for workbook navigation. The following is a snippet of code I have for the drop down box to change worksheets in the workbook:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not (Application.Intersect(Range("J4"), Target) Is Nothing) Then _
ThisWorkbook.Sheets("Home").Visible = False
ThisWorkbook.Sheets(Target.Value).Activate
ThisWorkbook.Sheets(Target.Value).Visible = True
ThisWorkbook.Sheets("Imported Data").Visible = False
End Sub
The code is meant to hide all other worksheets that are accessible by the drop down list besides the one selected. I have about 10 tabs and this code has worked perfectly to achieve the basic goal of navigation. However, some pages have formulas and when you update data in the cells meant for calculations the workbook jumps to a random worksheet in the workbook that is not at all referenced in this sub.
Is there some way to have my worksheets not try to do anything with this sub unless the dropdown menu itself is changed?
Bonus (less important) Question: is there a way to make the drop box default to (blank) unless the menu itself is accessed?
Then _
The space followed by an underscore _ means that the current statement isn't finished yet but continues on the next line. Right now the last 3 lines will run whenever there is a change in the worksheet. Put the entire code in If-Endif.
Also avoid unnecessary use of On Error Resume Next. Use proper error handling.
You need to make the sheet visible before you activate it and not vice versa.
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
If Not (Application.Intersect(Range("J4"), Target) Is Nothing) Then
ThisWorkbook.Sheets("Home").Visible = False
ThisWorkbook.Sheets(Target.Value).Visible = True
ThisWorkbook.Sheets(Target.Value).Activate
ThisWorkbook.Sheets("Imported Data").Visible = False
End If
Letscontinue:
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
is there a way to make the drop box default to (blank) unless the menu itself is accessed?
If you have created it with Data Valdation then insert a blank value in the list.
My macro generates a series of reports that are 60 columns wide. I want users to be able to review the reports on screen before printing them or going on to another segment of the macro.
it there a way to set a scrollarea, have user review it, and then have the respond to a message box to continue the routine?
I tried this:
Sub reviewdata()
' Application.ScreenUpdating = False
Worksheets("Fin. Stmts").ScrollArea = ""
Application.Goto Reference:="monthlydata"
ActiveCell.Offset(2, 1).Select
ActiveWindow.FreezePanes = True
Worksheets("data. Stmts").ScrollArea = "monthlydata"
If MsgBox("End Review", vbOKOnly) = vbOK Then
End If
ActiveWindow.FreezePanes = False
Worksheets("data. Stmts").ScrollArea = ""
End Sub
the problem is that once the if, then statement is executed the user can not move around the worksheet since the routine needs a response to continue.
any insights are most appreciated.
thanks.
You can Use a Dummy Variable:
Dim dummy As Range
Set dummy = Application.InputBox("Scroll and Check. After That Select Ok!", "This is Specially created so that you can", Default:="A1", Type:=8)
Input Box that Takes in Range Allows you to Scroll in Background. Keep hitting Ok in and nothing will change, code will run as it is running at the moment.
This is a little clumsy but it sort of gets what you want. Instead of using a MsgBox use and InputBox as a range, which will allow the user to click around and scroll, as you describe. Whenever they hit okay/cancel, the macro will continue.
So probably replace your MsgBox line of code with....
Dim boom As Variant
boom = Application.InputBox("When you're done hit ""Cancel""... (""OK"" might lead to problems...)", _
"Scroll around and look at stuff", _
, , , , , 8)
I would recommend doing two macros instead, but this probably does what you need.
You can show that message in a small userform and call that userform in modeless state as shown below.
UserForm1.Show vbModeless
This way you will be able to navigate in the sheet with that message still showing.
You can also put the rest of the code in the button click event as shown below.
Option Explicit
Private Sub CommandButton1_Click()
ActiveWindow.FreezePanes = False
Worksheets("data. Stmts").ScrollArea = ""
Unload Me
End Sub
I've got a bit of code that creates a Save button on a worksheet (held in the wsReport variable), but it doesn't remove previous buttons. Over time, they tend to build up. Is there any way to do something like this?
wsReport.Buttons.All.Delete
(Not right, obviously, but gives an idea of what I'm looking for.)
See code below :)
Sub RemoveButtons()
Dim i As Integer
If ActiveSheet.ProtectContents = True Then
MsgBox "The Current Workbook or the Worksheets which it contains are protected." & vbLf & " Please resolve these issues and try again."
End If
On Error Resume Next
ActiveSheet.Buttons.Delete
End Sub
Source:
http://www.mrexcel.com/forum/excel-questions/609668-delete-all-buttons-sheet-visual-basic-applications.html
or could you use code below:
(Buttons in VBA are in the Shapes collection).
Sub DelButtons()
Dim btn As Shape
For Each btn In ActiveSheet.Shapes
If btn.AutoShapeType = msoShapeStyleMixed Then btn.Delete
Next
End Sub
source:
Deleting a collections of VBA buttons
See the code below:
Sub DeleteAllShapes()
ActiveSheet.Shapes.SelectAll
Selection.Delete
End Sub
If somebody found this question, but needs to delete only one button, this helped me:
ActiveSheet.Shapes("my_button_name").Delete
There's an easier method that doesn't use VB:
Click the Developer tab
Click Design Mode
Click on any button in the worksheet
Press Ctrl + A to select all buttons in the worksheet
Press Delete
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