Show Image Based on cell values automatically - vba

I'm looking for some help with my code.
I want an image to show if 'Carga volumes' is choosen in at least one of the 3 cells. However, I need this macro to run automatically. My solution was call it on the sheet code however if the 3 cells have the same values it pastes the image 3 times. I only want it to paste once no matter how many times the 'Carga volumes' is choosen.
Do you know how I can modify my code?
If Worksheets("Tarifário_Envios carga").Range("$D$14") = "Carga volumes" Or Worksheets("Tarifário_Envios carga").Range("$D$32") = "Carga volumes" Or Worksheets("Tarifário_Envios carga").Range("$D$50") = "Carga volumes" Then
Worksheets("Preços_Envios Carga").Shapes("Picture 2").Copy
Worksheets("Tarifário_Envios carga").Range("D68:D69").PasteSpecial
End If

The event you can use is the Worksheet_Change event which will run anytime a change is made on that worksheet.
Instead of copying and pasting your image from another worksheet, place the image where you want it on the "Tarifário_Envios carga" worksheet, and hide it. When text is placed in the appropriate cells show it. The shape property you can use for this is .Visible. Showing/Hiding simplifies the process, pasting the image means you also need to remove the image if the text is not found.
I would also Name your image to make it easier to find if you need to reference it again.
Place this code in your "Tarifário_Envios carga" worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
' Only run through logic if we've modified one of these cells
If Target.Address = "$D$14" Or Target.Address = "$D$32" Or Target.Address = "$D$50" Then
'Set to hide image by default
Dim oShowCargaVolumes As Boolean
oShowCargaVolumes = False
'Mark to show image if specific text is in monitored cells
If UCase(Me.Range("$D$14").Value) = "CARGA VOLUMES" Then oShowCargaVolumes = True
If UCase(Me.Range("$D$32").Value) = "CARGA VOLUMES" Then oShowCargaVolumes = True
If UCase(Me.Range("$D$50").Value) = "CARGA VOLUMES" Then oShowCargaVolumes = True
'Show/Hide image
If oShowCargaVolumes Then
Sheet1.Shapes("imgNameHere").Visible = msoTrue
Else
Sheet1.Shapes("imgNameHere").Visible = msoFalse
End If
End If
End Sub

Related

Hiding the data in rows -Excel VBA

I have three rows.I want to hide the data in those rows and display those rows in different color.I tried searching but only found Entirerow.hidden,which hides the row number as well. Is it possible to only hide the data in the rows and display it using some other color?
The below code will change the background color to Yellow for rows 1 to 3.
Sub ChangeBackColorForSpecificRows()
Rows("1:3").Interior.Color = 65535
End Sub
Change the Rows and Interior Color to suit your requirement.
Edit:-
formupahidden set to true not working neither formatting it to locked
and hidden ,is hiding the content of formula bar – Sunaina
Copy the below code and do right click on sheet tab and select view code and paste it.
Close the VBA window (Alt+Q to close VBA window) and return to that sheet and check.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Rows("1:3")) Is Nothing Then
If Application.DisplayFormulaBar Then Application.DisplayFormulaBar = False
Else
If Not Application.DisplayFormulaBar Then Application.DisplayFormulaBar = True
End If
End Sub

unhiding rows based on cell value for data entry - refresh error

I've set up a worksheet that will allow the user to select preset options from a data validation list in a cell (B23). The user's selection off this one cell will then trigger certain rows to be unhidden, guiding the user to input data into only the appropriate rows. The VBA code I am using for unhiding the appropriate rows works fine, EXCEPT for the fact that whenever a user enters data into one of the unhidden rows, all the rows will hide. The user then needs to reselect their option from the initial data validation list (cell B23) to unhide the appropriate rows again. The value they enter is entered and saved in the cell, but they need to reselect their initial choice between each data entry step, which is annoying and what I'd like to fix.
I suspect that:
1)the VBA code I hobbled together doesn't account for the fact that users will be entering data into rows that are hidden / will be triggered to unhide, and/or
2) the crux of the problem is refreshing the cell with the data validation list (B23) that triggers which rows to be unhidden. I unfortunately have no idea how to do this.
Any help would be very much appreciated!!
My VBA code to hide rows is below.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim allRows As Range
Set allRows = Rows("27:64")
allRows.Hidden = True
If Not Intersect(Target, Range("B23")) Is Nothing Then
If Target.Value = "A1" Then
Rows("27:31").Hidden = False
ElseIf (Target.Value = "A10-A-S" Or Target.Value = "A10-A-P" Or Target.Value = "A10-A-T") Then
Rows("32:36").Hidden = False
ElseIf (Target.Value = "A10-B-S" Or Target.Value = "A10-B-P" Or Target.Value = "A10-B-T") Then
Rows("37:44").Hidden = False
ElseIf (Target.Value = "E19S" Or Target.Value = "E19P" Or Target.Value = "E19T") Then
Rows("46:54").Hidden = False
ElseIf (Target.Value = "E20S" Or Target.Value = "E20P" Or Target.Value = "E20T") Then
Rows("56:64").Hidden = False
End If
End If
End Sub
You're right that as soon as anyone changes anything on the worksheet, the Worksheet_Change event will fire and hide those rows.
A simple option would probably be to wrap that code around a check that the change was triggered by your dropdown:
With Target
If .Count = 1 Then
If .Row = 23 And .Column = 2 Then ' Assumes your list result is B23?
allRows.Hidden = True
' do your other checks and updates here...
End If
End If
End With
You should check if the target is B23 and if not Exit Sub. Maybe Something like this.
If Intersect(Target, Range("B23")) Is Nothing Then
Exit Sub
End If

How to fire on unhiding rows or columns

Some users hide columns/rows and forget to unhide them before saving a workbook. I want to catch that with unhide all columns/rows on the save event with
Sub ReInvisible()
ThisWorkbook.Worksheets(1).UsedRange.EntireRow.Hidden = False
ThisWorkbook.Worksheets(1).UsedRange.EntireColumn.Hidden = False
End Sub
this works fine but I would like to inform the user that all hidden columns/rows are now visible. Now I am looking for a way to trigger on unhiding a column/row so as soon as at least one column or row is made visible I want to fire a messagebox.
In VB.NET I would try to write my own event but in VBA I do not know how I can do a workaround. Does anyone have an idea?
Something like this should do it:
Sub ReInvisible()
Dim lVisColCount As Long
Dim lVisRowCount As Long
With ThisWorkbook.Worksheets(1).UsedRange
lVisColCount = .Rows(1).SpecialCells(xlCellTypeVisible).Count
lVisRowCount = .Columns(1).SpecialCells(xlCellTypeVisible).Count
.EntireRow.Hidden = False
.EntireColumn.Hidden = False
If .Rows(1).SpecialCells(xlCellTypeVisible).Count <> lVisColCount Then MsgBox "Columns unhidden"
If .Columns(1).SpecialCells(xlCellTypeVisible).Count <> lVisRowCount Then MsgBox "Rows unhidden"
End With
End Sub

VBA Grey Checkboxes

I would like to grey out my checkboxes in Excel VBA. When using Checkbox.Enabled = False, the checkbox is not editable, but it is also not grey. How do I get the greyed out effect?
Using form controls with Excel 2010. Inserted via developer tab directly into excel worksheet. Not used in a VBA userform.
Thanks!
Whenever anyone says "it is impossible", it hits my stubborn streak. So may I present to you: "The Impossible".
"Visible" and enabled checkbox:
"Disabled" checkbox (you can tweak the degree of visibility by changing values in the code for both color and transparency of the cover shape):
Basic idea: you place a semi transparent shape over the checkbox, and assign a dummy macro to it. Now you can't change the value of the checkbox. The "toggle" button is there to change the state - either place the shapes, or remove them. It uses a global variable to track the current state.
Finally - note that you can't use For Each when you delete (or add) shapes as you should not modify the collection you are iterating over. I circumvented that with a simple "count shapes, then iterate backwards by numerical index".
Is it a hack? You bet! Does it do what you asked? Yes!
Dim checkBoxesVisible As Boolean
Option Explicit
Sub toggleIt()
' macro assigned to "Toggle visibility" button
checkBoxesVisible = Not checkBoxesVisible
toggleCheckboxes checkBoxesVisible
End Sub
Sub grayOut(cb)
' put a "cover" shape over a checkbox
' change the color and transparency to adjust the appearance
Dim cover As Shape
Set cover = ActiveSheet.Shapes.AddShape(msoShapeRectangle, cb.Left, cb.Top, cb.Width, cb.Height)
With cover
.Line.Visible = msoFalse
With .Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0.4
.Solid
End With
End With
cover.Name = "cover"
cover.OnAction = "doNothing"
End Sub
Sub doNothing()
' dummy macro to assign to cover shapes
End Sub
Sub unGray(cb)
' find the cover shape for the checkbox passed as the argument
' and delete it
' "correct shape" has the name "cover" and is properly aligned with top left
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.Name = "cover" And sh.Left = cb.Left And sh.Top = cb.Top Then
sh.Delete
Exit For
End If
Next sh
End Sub
Sub toggleCheckboxes(onOff)
Dim s As Shape
Dim n As Integer, ii As Integer
n = ActiveSheet.Shapes.Count
' loop backwards over shapes: if you do a "For Each" you get in trouble
' when you delete things!
For ii = n To 1 Step -1
Set s = ActiveSheet.Shapes(ii)
If s.Type = msoFormControl Then
If s.FormControlType = xlCheckBox Then
If onOff Then
unGray s
Else
grayOut s
End If
End If
End If
Next ii
End Sub
A slight hack - but the following does work. I created a simple userform with two controls - a regular checkbox (CheckBox1), and a button I called "DisableButton" with the following code:
Private Sub DisableButton_Click()
CheckBox1.Enabled = Not (CheckBox1.Enabled)
If CheckBox1.Enabled Then
CheckBox1.ForeColor = RGB(0, 0, 0)
Else
CheckBox1.ForeColor = RGB(128, 128, 128)
End If
End Sub
When I clicked the button, the checkbox was grayed out and unavailable. Clicking it again "brought it back to life". I think this is the effect you were looking for. If it's not - that's what comments are for.
Here is what it looks like:
I am afraid it is impossible what you are trying to do within a worksheet. You can refer to the Floris' answer if you are using an UserForm.
For more details on the properties of (Form/worksheet) check boxes see MSDN
Maybe this is what you want.
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
CheckBox2.Value = False
CheckBox2.Enabled = False
CheckBox2.ForeColor = rgbBlue
Else
CheckBox2.Visible = True
CheckBox2.ForeColor = rgbAntiqueWhite
CheckBox2.Enabled = True
End If
Code tels that when checkbox1 is checked, checkbox2 is disabled; unchecked and the forecollor changes. the colors can be what you want.
Did this with the checkboxes directly in the excel worksheet.
Based on Floris' idea.
The code assumes all the controls are on ActiveSheet and they are called CheckBox1 and CheckBox2, if not, change it accordingly.
You can call this when you click on CheckBox1 or you can call it from another sub, with an optional ticked status (True/False) to check or uncheck CheckBox1.
Draw an object on top of CheckBox2 and name it "mask" (you can name it anything else but then you have to change the code accordingly)
Give mask the same fill color as your background color and opacity of around 50%.
Public Sub CheckBox1_Click(Optional ticked As Variant)
Application.ScreenUpdating = False
ActiveSheet.Unprotect
If Not IsMissing(ticked) Then
If ticked = True Then ActiveSheet.Shapes("CheckBox1").OLEFormat.Object.Value = 1 Else ActiveSheet.Shapes("CheckBox1").OLEFormat.Object.Value = -4146
End If
If ActiveSheet.Shapes("CheckBox1").OLEFormat.Object.Value > 0 Then
ActiveSheet.Shapes("mask").OLEFormat.Object.ShapeRange.ZOrder msoSendToBack
Else
ActiveSheet.Shapes("mask").OLEFormat.Object.ShapeRange.ZOrder msoBringToFront
End If
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub
Now each time you tick CheckBox1, mask comes to front to hide CheckBox2 and when you untick it, mask goes to back to unhide it. Since it is opaque, it gives you the greyed out effect and you don't even have to worry about enable/disable either.
Worksheet should be protected so that user can't accidentally move or edit mask, but should be unprotected for SendToBack/BringToFront to work, so the code does that. Please check the protection settings at the Application.Protect part.

(Excel VBA) If Cell Value equals "" Then Show/Hide Images

I am working on a Excel Spreadsheet that when a dropdown box value is selected an image will pop up, and if another value is selected it will hide the current image and pop up the image related to the selection. I have found a few methods that are just too time consuming using just the sheet and positioning of the image using coordinates; that's not exactly the route I would like to go.I have done a quite a bit of research before using StackOverflow, and nothing seemed to work thus far. Below is what I am trying to achieve. I am trying to keep all the images within the spreadsheet which adds another level of challenge, but I believe there is a way to do this because excel assigns the image a number when inserted EX. Picture 9.
Sub Main()
If Range(G11).Value = "anything" Then
Picture1 show
Picture2 hide
End If
End Sub
Any Help is greatly appreciated. Thanks
Rather than hiding/moving/reducing the size of the unwanted pic, why not simply delete it?
Logic:
Save all your images in a temp sheet. When ever a relevant picture is supposed to be shown, get it from the temp sheet and delete the previous.
Here is an example.
Sub Sample()
Select Case Range("G11").Value
Case "Picture 1": ShowPicture ("Picture 1")
Case "Picture 2": ShowPicture ("Picture 2")
Case "Picture 3": ShowPicture ("Picture 3")
Case "Picture 4": ShowPicture ("Picture 4")
End Select
End Sub
Sub ShowPicture(picname As String)
'~~> The reason why I am using OERN is because it is much simpler
'~~> than looping all shapes and then deleting them. There could be
'~~> charts, command buttons and other shapes. I will have to write
'~~> extra validation code so that those shapes are not deleted.
On Error Resume Next
Sheets("Sheet1").Shapes("Picture 1").Delete
Sheets("Sheet1").Shapes("Picture 2").Delete
Sheets("Sheet1").Shapes("Picture 3").Delete
Sheets("Sheet1").Shapes("Picture 4").Delete
On Error GoTo 0
Sheets("Temp").Shapes(picname).Copy
'<~~ Alternative to the below line. You may re-position the image
'<~~ after you paste as per your requirement
Sheets("Sheet1").Range("G15").Select
Sheets("Sheet1").Paste
End Sub
Snapshot of temp sheet
Here is a solution using the Visible property of the object.
I used this to show a picture based on a value in a field.
The field had a formula that resulted in either "good" or "bad".
If its value was "good", I wanted to show one picture; for "bad", another picture should show; and they should never show at the same time.
The field needed to update its value whenever a user refreshed a pivot table, so I put the code in that method of the worksheet where the pivot table and picture were to appear.
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'hide both pictures by loopng through all the shapes on the sheet
Dim s As Shape
For Each s In ActiveSheet.Shapes
'hide the shape if it is a picture, leave other shapes on the page visible.
If s.Type = msoPicture Then s.Visible = msoFalse
Next
Dim judgement As String
'The field whose value tells what picture to use is a one-cell named range called "judgement"
judgement = Range("judgement")
'you need to know which picture is which.
If judgement = "Good" Then ActiveSheet.Shapes("Picture 8").Visible = True
If judgement = "Bad" Then ActiveSheet.Shapes("Picture 1").Visible = True
End Sub
Sub hidePicture(myImage)
ActiveSheet.Shapes.Range(Array(myImage)).Select
Selection.ShapeRange.Height = 0
Selection.ShapeRange.Width = 0
End Sub
Sub showPicture(myImage)
ActiveSheet.Shapes.Range(Array(myImage)).Select
Selection.ShapeRange.Height = 200
Selection.ShapeRange.Width = 300
End Sub
Handy tip: record macro and look at the code it generates!
Might be better just to move your pictures "off screen", particularly if they're of different sizes.
Sub Tester()
ShowPicture "Picture 3"
End Sub
Sub ShowPicture(PicName As String)
Dim s As Shape
For Each s In ActiveSheet.Shapes
With s
.Top = IIf(.Name = PicName, 100, 100)
.Left = IIf(.Name = PicName, 100, 1000)
End With
Next s
End Sub