Solved

Excel Command Button to Clear Sheet and Display Shapes

Posted on 2011-02-14
4
380 Views
Last Modified: 2012-05-11
Many thanks to rorya for his awesome skill in providing this UDF!!!  I've tried to create a command button to clear the shapes and call the function, but have been unsuccessful.  I would greatly appreciate an example with instructions on how to use a command button to call this function and display my shapes. cmdbtnEE.xlsm
0
Comment
Question by:asc2010
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34889028
You don't need a button - you just need to move the function code from the worksheet module into a normal module in the workbook. It automatically creates and deletes shapes as required.
0
 

Author Comment

by:asc2010
ID: 34889094
My spreadsheet does not delete the shapes after the percentage is changed.  I moved the function back into the module as suggested.  Do I need to change something else? cmdbtnEE.xlsm
0
 
LVL 85

Accepted Solution

by:
Rory Archibald earned 500 total points
ID: 34889267
As I recall, my original code named the shapes (or do I misremember?). Delete all the shapes (f5, Special... button, select Objects, then press Delete), then replace the code with this:
Function ShowStatus(rng As Range)
   Dim shp1 As Shape, shp2 As Shape
   Dim wks As Worksheet
   Dim rngCell As Range
   Set rngCell = Application.Caller
   Set wks = rngCell.Worksheet
   On Error Resume Next
   With wks
      .Shapes("ProgBar" & Application.Caller.Address & "_1").Delete
      .Shapes("ProgBar" & Application.Caller.Address & "_2").Delete
   End With
   With rngCell
      'Set shp2 = wks.Shapes.AddShape(msoShapeRectangle, .Left, .Top, 100, .Height)
      'Set shp1 = wks.Shapes.AddShape(msoShapeRectangle, .Left, .Top, rng.Value * 100, .Height)
      Set shp2 = wks.Shapes.AddShape(msoShapeRoundedRectangle, .Left, .Top, 100, .Height)
      shp2.Name = "ProgBar" & Application.Caller.Address & "_2"
      Set shp1 = wks.Shapes.AddShape(msoShapeRoundedRectangle, .Left, .Top, rng.Value * 100, .Height)
      shp1.Name = "ProgBar" & Application.Caller.Address & "_1"
      shp1.Fill.ForeColor.SchemeColor = 7
   End With
End Function

Open in new window

0
 

Author Closing Comment

by:asc2010
ID: 34889349
rorya,

Thank you so much for clarifying this!! I noticed the with statement that deletes the shapes.  I thought it was not working because I moved the shapes away from their original position.  Once moved, they remain on the sheet.  I will leave them in place! Thanks again!
0

Featured Post

Revamp Your Training Process

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

630 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question