Have several logo images (similarly sized) inserted on a resources sheet. Need a way for users to easily select which company they want, and have that logo replace the default logo in upper left corner of several sheets.
Want to use a dropdown menu, have used dynamically before with great results. Dropdown can be in a userform or on just out on dashboard sheet. I already looked as stacking logos and trying a z-axis switch but Excel doesn't seem to support this. I've also tried .Replace and .Copy.
Again, logos are already pasted into a resource sheet that gets hidden, so I don't want users to go hunt down an image directory nor rely on an internet connection to fetch the image (they sometimes work offline). A default image is already emplaced in upper left corners, just need a way to match their (text) company selection to the corresponding logo image/name, and then switch the old logo with new on one several pages that I specify, in the same upper left corner.
Edit:
Here's a mishmash of what's I've tried so far, various lines uncommented at various times, and at this point some lines really don't make sense in the way it's presented. Only posting for street cred I guess. I'm just trying to get one small feature figured out, not asking anyone to write my program for me (which is a big difference in scope):
Private Sub CompanySelectComboBox_Change()
If CompanySelectComboBox.Value <> "Select a company" Then
' select logo here Sheets(Sheets("TaskNew").Index + TaskSheetsComboBox.ListIndex + 1).Activate
'Private Sub TaskSheetsComboBox_Click()
'If TaskSheetsComboBox.Value <> "Go directly to a yellow task sheet" Then
' Sheets(Sheets("TaskNew").Index + TaskSheetsComboBox.ListIndex + 1).Activate
'End If
'End Sub
MsgBox CompanySelectComboBox.Value
MsgBox CompanySelectComboBox.ListIndex
Image("Logo").Replace Image("Logo"), Sheets("Config").Image("Logo2")
'Logo.Select
' another possibility:
' LogoPic.Picture = LoadPicture(Fname)
' another possibility:
'Sheets("Configs").Image("Logo").Copy Before:=Sheets("TaskEnd")
' another possibility:
'CodeNames of Sheets
'Sheets("Configs").Shapes("Picture 1").Copy
'Sheets("Dashboard").Range("A1").PasteSpecial
Else
' user didn't select a company, so just keep default (Generic) for now
End If
End Sub
Try
http://www.officevb.com/2009/11/utilizando-o-procv-com-imagens.html
Well, after your explanation I changed -1 to +1. Let's break the problem into parts.
First, in your resource sheet, place your pictures in column B. Give each picture a (company name) in column A. You can adjust the row height so each picture fits into it's own row.
Then this is an example how you associate the names with those pictures:
Dim sh As Worksheet, pic As Shape
Set sh = ThisWorkbook.Worksheets("Pictures")
For Each pic In sh.Shapes
If pic.Type = msoPicture Then
Debug.Print pic.TopLeftCell.Cells(1, 0) ' print the company name
End If
Next
Now, you can create a combo box or user dialog from that, ask the user which company he wants and let him select a name. Here is an example function to copy a picture of a given name to the clipboard:
Function CopyLogoToClipboard(picName As String) As Boolean
Dim sh As Worksheet, pic As Shape
Set sh = ThisWorkbook.Worksheets("Pictures")
For Each pic In sh.Shapes
If pic.Type = msoPicture And pic.TopLeftCell.Cells(1, 0) = picName Then
pic.Copy
CopyLogoToClipboard = True
Exit Function
End If
Next
CopyLogoToClipboard = False
End Function
(don't forget to check the return value when you use it).
Now, the last part is to insert the logo to the places where you want it. For example, putting it in the upper left corner on the active sheet:
ActiveSheet.Paste
Set pic = Selection.ShapeRange(1)
pic.Top = 0
pic.Left = 0
Hope this helps.
Related
I have a workbook that is a 'quick print' sheet for my workplace.
I am not very skilled with VBA, but I have found various bits from web searches that have given me mostly desired results.
This is the desired look of the sheet:
The column C and D is a List Box with the VBA code:
Private Sub Worksheet_Activate()
Dim Sh
Me.ListBoxSh.Clear
For Each Sh In ThisWorkbook.Sheets
Me.ListBoxSh.AddItem Sh.Name
Next Sh
End Sub
The print icon in D2 is linked to macro:
Sub Print_Sheets()
Dim i As Long, c As Long
Dim SheetArray() As String
With ActiveSheet.ListBoxSh
For i = 0 To .ListCount - 1
If .Selected(i) Then
ReDim Preserve SheetArray(c)
SheetArray(c) = .List(i)
c = c + 1
End If
Next i
Application.Dialogs(xlDialogPrinterSetup).Show
Worksheets(SheetArray()).PrintOut Copies:=1
End With
End Sub
and finally the sheet has following in ThisWorkbook in order to refresh the List Box and put the user on the correct page:
Private Sub Workbook_Open()
Sheets(2).Select
Sheets(1).Select
End Sub
The final bit of VBA seems to work as intended, but I included it anyway in case it could interfere with something (I don't think it can, but just to be sure).
The List Box populates as intended, but I can't get it to stay the width of the columns C:D, and the height of the populated cells in B, every time the workbook is opened the box will increase in size both to the right and down.
The print button works mostly as intended; when clicked it will prompt with available printers, and then OK to print, but cancelling still causes the document to print. It will also allow the printing of the "Please Select..." page - the name of the sheet this form is on - which I have tried to stop from happening but can't get it to work.
On the point of having the list box resize correctly, I have followed this answer but I can't figure out how to keep the size as the range, rather than an integer.
Edit: I have now figured out that I can use Me.ListBoxSh.Width = Range("C:D").Width to set the width the same as the desired columns, as well as Me.ListBoxSh.Height = Range("3:7").Height for the height in the image shown. However, I will be adding to this list and am not sure how to have the VBA code work as "Start in row 3 and continue until an unpopulated row".
On not being able to print the "Please Select..." sheet, I followed this guide and it didn't seem to do anything at all. I had changed the WsName = "Sheet1" line to read WsName = "Please Select..." also.
Any help would be appreciated.
I am working on an excel file that will work as a calendar with specifications.
I want to have a button at each day. Since I want this to be reusable for other years, I will have buttons on columns with no days (for example, if January starts on a tewsday, Monday will have a button, but nothing on the day, since it is from December).
I know it is possible to set a button enable = False, but I don't know where to put that code. I don't want it to be disabled when another button is clicked but at the opening of the file.
I am new to vba, I'm sorry if this is something really simple.
My approach needs those cells with days from previous month to be empty or "", if theres any value inside it wont work (instead you change the logic to treat cells values like numbers instead of strings).
I noticed that days in your calendar are in string format or so (i.e: "01") that's why I use Len() to evaluate length of string.
This code will set buttons visibility based on TopLeftCell value. Visible = True to days with some value, and Visible = False to empty values.
There is a way to make a button "Enable" but that property is for buttons inside an UserForm.
Tell me if it works for your case, since Sheet.CurrentRegion may cause some issues if your cells are way to much separate from each other, plus it could also hide some other buttons you have. If any of those scenarios do happen let me know, I'll continue helping you anyways!
Sub Set_Buttons_Visibility()
Dim Sheet As Worksheet
Dim Calendar_DataBodyRange As Range
Dim Shape As Shape
'Set Calendar range
Set Sheet = ActiveSheet 'Set Sheet
Set Calendar_DataBodyRange = Sheet.Cells(1, 1).CurrentRegion 'Set current region
Calendar_DataBodyRange.Select '<- comment this after you tested everything[']
'Hide buttons from previous month
For Each Shape In Sheet.Shapes
'If Shape.Visible Then Shape.Select
'Get variables
'Get Button day, as string
strTemp = CStr(Shape.TopLeftCell)
'Get range occupied by button
Set rngTemp = Sheet.Range(Shape.TopLeftCell, Shape.BottomRightCell)
'rngTemp.Select
'Test conditions
'Test rngTemp is part of Calendar_DataBodyRange
bInRange = Not Intersect(Calendar_DataBodyRange, rngTemp) Is Nothing
'Test TopLeftCell has some string
bString = (Len(strTemp) > 0)
'Test bInRange and bShow (True and True)
bCondition = (bString = False) And bInRange
'Perform action
'Set shape visibility
Shape.Visible = Not (bCondition)
'Delete shape (only if you have another procedure to rebuild all buttons)
''''Shape.delete
Next
End Sub
Run code when workbooks opens
To start this function when workbook opens, go to VBA Project Explorer > ThisWorkbook then inside the module you can bind your code to Workbook_Open event. Later on (depending in where you've have stored your code) use the following Run function.
Important:
According to your case you might need to store your code 1) inside the sheet you are working on, in other cases you store your code 2) in a single sheet usually called PERSONAL.XLSB that is always open when Excel itself Opens (Know more about this) so your functions can be accesible for all sheets that you work on.
Pros and Cons:
On the first case is perfect for sharing your work with your boss or colleagues since your code is locally stored in the sheet (but is harder to update, and hard to back up) and the second case is optimal for your own use since all your functions are in the same workbook so you can call it like "[Workbook.Name]![FunctionName],[FunctionParameters]" (allows you to do better updating and an easier backup just by copy-pasting). In any case you can addapt to your necessities.
Private Sub Workbook_Open()
'Run sintax needs Workbook [extension] and string [!]
'Function is stored in current workbook (case 1)
Run ThisWorkbook.Name & "!Set_Buttons_Visibility"
'Function is stored in PERSONAL (case 2)
Run "PERSONAL.XLSB!Set_Buttons_Visibility"
End Sub
I am trying since 2 days to find how to do the following without finding anything that suits the aim:
Steps by order :
user open excel file
he chose between folowing :
Paste an image directly in the worksheet (may be an limited area)
activate some video in the workbook (may be a webcam for start)
he select with a button to activate his clicks detection
he clicks anywhere on the picture and i get the coordinates of clicked points
So far i've seen ppl using (and tested myself) :
mouse event ==> this does not work as i need to know the name of what he is clicking on and it may be a brand new picture he just pasted
BeforeDoubleClick (same, i'd prefer avoid doubleclick but even then it doesnt work when i click on something else but cells)
Selectionchange ==> doesnt work if im not clicking on cells
Place hidden button over the area i want : i cant click a button if its not visible, and it becomes visible when i click it if i put as transparent
If anyone has ideas about this...
(nb: im not a pro of vba so i may have missed something)
Just forgot : my issue is not getting the coordinates of mouse, its just triggering the macro when i want, for now im jsut trying to get a simple msgbox to see if trigger works.
Thanks if anyone has any ideas
BR
Not sure if this fits your need (for example couldn't test it with a video).
a) Place a "button" of any kind on your sheet. I usually use a square shape for that and format it a little bit (color, shade, text). Assign the subroutine SetEvents to it.
b) Declare a global variable that remembers that click-activation is active
Option Explicit
Global EventCatchingActive As Boolean
c) In the event routine of your button, set the OnAction-method for all shapes of the sheet - see the routine setEvents. This ensures that even newly added images handle the click event.
Sub setEvents()
' This routine is called from the magic button.
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1) ' Set this to whatever sheet you need
Dim button As Shape
Set button = ws.Shapes(Application.Caller)
If EventCatchingActive Then
EventCatchingActive = False
button.TextFrame2.TextRange.Characters.Text = "Start Clicking"
Else
Debug.Print "Setting EventHandler"
Dim sh As Shape
For Each sh In ThisWorkbook.Sheets(1).Shapes
' Debug.Print sh.Name, sh.Type
If sh.Name <> button.Name Then sh.OnAction = "ClickedMe"
Next
EventCatchingActive = True
button.TextFrame2.TextRange.Characters.Text = "Stop Clicking"
End If
End Sub
d) Declare a routine that is called if any of the shapes is clicked. With Application.Caller you can check what was clicked.
Sub ClickedMe(Optional target As Range = Nothing)
If Not EventCatchingActive Then Exit Sub
If target Is Nothing Then
Debug.Print "I clicked on " & Application.Caller
Else
Debug.Print "I clicked on cell " & target.Address
End If
End Sub
(note that code of steps b) to d) goes into a regular module)
e) If you also want to handle clicks on a cell, add the following into the sheet-module of the worksheet you are dealing with.
Private Sub Worksheet_SelectionChange(ByVal target As Range)
ClickedMe target
End Sub
I have found a simple script that allows for hiding or showing a picture using the text in a shape. I like the functionality and would like to apply it to our list of employees. However, the way it is constructed right now would require me to add one macro for each person and that is not sustainable in the long run.
Is there a way to re-write this script so it sets the name of the picture based on the name of the employee that is located in column A? Then it would be really simple to just insert images and name them with the Employee name.
I also see that the button is mentioned in the code. So this also needs to be written more dynamically. Could I use a normal format control instead of a shape? (The button does not need to change the displayed text as in this script.)
I really would appreciate your help here. This would look really smooth and I think others would make good use of a VBA like this too.
Sub Macro1()
With ActiveSheet.Shapes("Rounded Rectangle 4").TextFrame2.TextRange.Characters
'Check if shape text is equal to "Hide"
If .Text = "Hide" Then
'Change shape text to "Show"
.Text = "Show"
'Hide shape
ActiveSheet.Shapes("Picture 1").Visible = False
'Continue here if shape is not equal to "Hide"
Else
'Change text to "Hide"
.Text = "Hide"
With ActiveSheet.Shapes("Rounded Rectangle 4")
'Move image named "Picture1" based to lower right corner of shape
ActiveSheet.Shapes("Picture 1").Left = .Left + .Width
ActiveSheet.Shapes("Picture 1").Top = .Top + .Height
'Show image
ActiveSheet.Shapes("Picture 1").Visible = True
End With
End If
End With
End Sub
Reference: https://www.get-digital-help.com/show-and-hide-a-picture-vba/
Example data:
First, I'd like to say that you would be much better off designing something like this in MS Access as opposed to Excel. There are lots of tutorials showing how to build exactly this with Access Forms. It would certainly be much easier to maintain.
That being said, your question was about doing this in Excel and I'll answer that with a simple implementation suggestion. Just bare in mind, it comes with what I would consider "messy" maintenance.
First, you have a bunch of shapes representing the show/hide buttons. Each of these shapes would need to have their own unique name (not important what the name is for this case) and each of them would need to be positioned inside the cell for the row they are meant to operate on (as shown in your example photo).
Next, each employee's photo would need to be named the same as your employee name (the value in column A in your example).
Lastly, you would need to set the "Assigned Macro" of each show/hide button to the same method (I've named my Button_Click()). That method implementation looks like this:
Sub Button_Click()
Dim clickedButton As Shape
Dim employeePhoto As Shape
Dim clickedButtonRow As Long
Dim employeeName As String
'// gets the row number in whcih the clicked button resides
Set clickedButton = ActiveSheet.Shapes(Application.Caller)
clickedButtonRow = clickedButton.TopLeftCell.Row
'// gets the employee name (column A in this case)
employeeName = ActiveSheet.Range("A" & clickedButtonRow).Value
Set employeePhoto = ActiveSheet.Shapes(employeeName)
With clickedButton
' //set the position of the employee photo
employeePhoto.Top = .Top + .Height
employeePhoto.Left = .Left + .Width
With .TextFrame.Characters
'// set the visibility of the associated employee picture based on the text state of the button
employeePhoto.Visible = .Text = "Show"
'// swap the label on the button
If ActiveSheet.Shapes(employeeName).Visible Then
.Text = "Hide"
Else
.Text = "Show"
End If
End With
End With
End Sub
When applying the solution from ArcherBird I discovered a need to add a button in the headline to hide/show all pictures. This provides for a better user experience.
I added this script to the sheet (not in a module) and connected it to a button.
In my document I have our company logo in the headline and I kept this visible at all times.
I hope somebody find this set-up useful! :-)
Dim c As Boolean
Sub Button4_Click()
c = c Xor True
ActiveSheet.Pictures.Visible = c
ActiveSheet.Pictures("CompanyLogo").Visible = True
End Sub
I'm developing an Excel 2010 workbook, in a manual formulas calculation mode.
(file -> options -> formulas -> Workbook calculation -> manual)
I have some command buttons in the sheet (ActiveX controls), and I set them to move and size with cells (right click on the button -> format control -> Properties -> move and size with text).
This is since I have some rows filtered out under some conditions, and I want the buttons placed in these rows to appear and disappear as well, according to the display mode of their hosting rows.
It all goes perfectly fine, till I save he worksheet when some of the rows (hence buttons) are filtered out (i.e. not displayed).
When I re-open the file again, and expand the filtered rows, the buttons don't show. When checking their properties I see that their visible property is True, but their height is 0, and this doesn't change when I un-filter their hosting rows.
I want to emphasize again that before saving the file - both filtering and un-filtering the buttons worked well.
Would much appreciate any help here.
OK so I get the same results either with ActiveX or Form Controls. For whatever reason, it seems the control's original height does not persist beyond the save & close.
Another option would be to simply clear the AutoFilter on the Workbook's Close and Save events. However, this probably is not what you want if you like to leave some filter(s) on when you save and re-open the file. It's probably possible to save the filter parameters in a hidden sheet or by direct manipulation of the VBE/VBA, but that seems like a LOT more trouble than it's worth. Then you could re-apply the filter(s) when you re-open the workbook.
Here is what code I suggest
NOTE: I relied on the worksheet's _Calculate event with a hidden CountA formula (setting, changing, or clearing the AutoFilter will trigger this event). I put the formula in E1 just so you can see what it looks like:
Since your application relies on Calculation = xlManual then this approach will not work exactly for you but in any case, the subroutine UpdateButtons could be re-used. You would need to tie it in to another event(s) or functions in your application, as needed.
Here is the code
Option Explicit
Private Sub UpdateButtons()
'## Assumes one button/shape in each row
' buttons are named/indexed correctly and
' the first button appears in A2
Dim rng As Range
Dim shp As Shape
Dim i As Long
Application.EnableEvents = False
'## use this to define the range of your filtered table
Set rng = Range("A1:A6")
'## Iterate the cells, I figure maybe do this backwards but not sure
' if that would really make a difference.
For i = rng.Rows.Count To 2 Step -1
Set shp = Nothing
On Error Resume Next
Set shp = Me.Shapes(i - 1)
On Error GoTo 0
If Not shp Is Nothing Then
DisplayButton Me.Shapes(i - 1), Range("A" & i)
End If
Next
Application.EnableEvents = True
End Sub
Private Sub DisplayButton(shp As Shape, r As Range)
'# This subroutine manipulates the shape's size & location
shp.Top = r.Top
shp.TopLeftCell = r.Address
shp.Height = r.Height
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "_Change"
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
''## Assumes one button/shape in each row
'' buttons are named/indexed correctly and
'' the first button appears in A2
'Dim rng As Range
'Dim shp As Shape
'Dim i As Long
'
''## Uncomment this line if you want an annoying message every time
''MsgBox "Refreshing Command Buttons!"
'
'Application.EnableEvents = False
''## use this to define the range of your filtered table
'Set rng = Range("A1:A6")
'
''## Iterate the cells, I figure maybe do this backwards but not sure
'' if that would really make a difference.
'For i = rng.Rows.Count To 2 Step -1
' Set shp = Nothing
' On Error Resume Next
' Set shp = Me.Shapes(i - 1)
' On Error GoTo 0
'
' If Not shp Is Nothing Then
' DisplayButton Me.Shapes(i - 1), Range("A" & i)
' End If
'Next
'
'Application.EnableEvents = True
End Sub
For Another option See this article. You can re-purpose existing commands with RibbonXML customization. While this article is geared towards C# and Visual Studio it's possible to do it with the CustomUI Editor.
I had a similar problem with buttons disapearing (moving on upper left corner) when removing filters.
A solution I found was to add a row above the columns headers so that buttons were still appearing at the top of the columns but were not touching the row where filters were placed.
Adding / removing filters stop interfering with buttons' positions.
I had a similar problem where form buttons appear to work fine, but then disappear after saving and reopening the workbook. Specifically this happened when the form button where part of hidden rows (done using vba code).
Seems like a real bug, although I don't know where the link is.
By changing the form buttons to ActiveX buttons, the buttons stopped disappearing, but started moving/bunching to the top of the screen when the rows were hidden. I just added some vba to re-position the buttons (e.g. CommandButton1.Top = Range(A12:A12).Top --> moves the ActiveX command button to the 12th row).