Move Label Button with cell value

[VIJAY48]

Hi

I am having a command button on sheet1 on cell "E9". I need three conditions to be fulfilled.

1. When the button is clicked it should expand the hidden 7 rows below with caption "hide"
2. When the button is clicked again, it should hide the 7 rows below with caption "Enter"
3. If the value in Cell "E9" is greater than zero the button should move to left ie "D9" with caption "Amend", else remain same in the position,with caption "Enter".

how to do this by Vba?

Anybody can help.

Vijay

[LJMetzger]

Hi VIJAY48,

Try the following Macros which are included in the attached sample file. Please let me know if I didn't follow your instructions.

Part of the solution is to use a 'Forms' Command Button with the name 'Button HideOrEnter'. Included is macro RenameActiveShape(), which can be invoked by 'Right Clicking' on a Shape, and then running the macro .

In the ThisWorkbook module:

Private Sub Workbook_Open()
  'Force the CommandButton to contain the proper text
  Sheets("Sheet1").Select
  Call ProcessCommandButtonHideOrEnter
End Sub

In an ordinary code module:

Option Explicit

Private Const sButtonNAME = "Button HideOrEnter"
Private Const sDisplayOrHideROWS = "10:16"

Sub ProcessCommandButtonHideOrEnter()

  Dim dValueE9 As Double
  Dim iFirstRowInDisplayOrHideRange As Long
  Dim sCaller As String
  Dim sRange As String
  Dim sValueE9 As String

  'Determine whether this routine was called by the CommandButton or by another mean
  'NOTE: A RUNTIME error will be generated if the routine is not called from a Command Button
  On Error Resume Next
  sCaller = Application.Caller
  On Error GoTo 0
  
  'Get the Value in Cell 'E9' as a string
  'Convert the value to a Number if possible
  sValueE9 = Range("E9").Value
  If IsNumeric(sValueE9) Then
    dValueE9 = CDbl(sValueE9)
  End If
  
  
  'If the routine is NOT CALLED from the CommandButton
  'a. Make sure the CommandButton has the correct text
  'b. Exit
  If sCaller <> sButtonNAME Then
    'Determine if the rows are hidden or visible
    iFirstRowInDisplayOrHideRange = Range(sDisplayOrHideROWS).Row
    
    If dValueE9 > 0# Then
      ActiveSheet.Shapes(sButtonNAME).TextFrame.Characters.Text = "Amend"
      ActiveSheet.Shapes(sButtonNAME).Left = Range("D9").Left
      ActiveSheet.Shapes(sButtonNAME).Top = Range("D9").Top
    ElseIf Rows(iFirstRowInDisplayOrHideRange).Hidden = True Then
      ActiveSheet.Shapes(sButtonNAME).TextFrame.Characters.Text = "Enter"
    Else
      ActiveSheet.Shapes(sButtonNAME).TextFrame.Characters.Text = "Hide"
    End If
    Exit Sub
  End If
  
  
  'Determine if the rows are hidden or visible
  'If the rows are Hidden,  then change the CommandButton Text to "Hide" and Display the Rows
  'If the rows are Visible, then change the CommandButton Text to "Enter" and Hide the Rows
  'NOTE: The logic below is the inverse of the logic when the routine is NOT called from the CommandButton
  iFirstRowInDisplayOrHideRange = Range(sDisplayOrHideROWS).Row
  If dValueE9 > 0# Then
      ActiveSheet.Shapes(sButtonNAME).TextFrame.Characters.Text = "Amend"
      ActiveSheet.Shapes(sButtonNAME).Left = Range("D9").Left
      ActiveSheet.Shapes(sButtonNAME).Top = Range("D9").Top
  ElseIf Rows(iFirstRowInDisplayOrHideRange).Hidden = True Then
    ActiveSheet.Shapes(sButtonNAME).TextFrame.Characters.Text = "Hide"
    ActiveSheet.Rows(sDisplayOrHideROWS).EntireRow.Hidden = False
  Else
    ActiveSheet.Shapes(sButtonNAME).TextFrame.Characters.Text = "Enter"
    ActiveSheet.Rows(sDisplayOrHideROWS).Hidden = True
  End If
  
End Sub

Sub RenameActiveShape()
  'This renames the 'Active Shape' (new name is obtained via 'InputBox')

  Dim sData As String
  Dim sOldShapeName As String
  Dim sName As String
  Dim sNewShapeName As String

  'Get the name of the 'Active Shape'
  'Exit if there is none
  On Error Resume Next
  sOldShapeName = Application.Selection.Name
  If Err.Number <> 0 Then
    MsgBox "There is no Active Shape selected."
    GoTo ERROR_EXIT
  End If
  
  'Get the new 'Shape Name' (without leading and trailing BLANKS)
  sData = "Enter the New Name for Shape '" & sOldShapeName & "'" & vbCrLf & _
          "then Select 'OK'"
  sNewShapeName = InputBox(sData, "Shape Rename")
  sNewShapeName = Trim(sNewShapeName)
  
  'Verify that the name isn't BLANK
  If Len(sNewShapeName) = 0 Then
    MsgBox "Nothing done. The new Name is BLANK or CANCEL was selected." & vbCrLf & _
           "Try again with a name that is Unique on the Sheet."
    GoTo ERROR_EXIT
  End If
  
  'Verify that the name does not already exist
  'No error means the name already exists
  sName = ActiveSheet.Shapes(sNewShapeName).Name
  If Err.Number = 0 Then
    MsgBox "Nothing done.  New Name '" & sNewShapeName & "' already exists." & vbCrLf & _
           "Try again with a name that is Unique on the Sheet."
    GoTo ERROR_EXIT
  End If
  
  'Rename the Shape
  ActiveSheet.Shapes(sOldShapeName).Name = sNewShapeName
  
  'Display a Message
  MsgBox "The Active Shape was renamed." & vbCrLf & _
         "Old Name: '" & sOldShapeName & "'" & vbCrLf & _
         "New Name: '" & sNewShapeName & "'"
  
ERROR_EXIT:
  On Error GoTo 0

End Sub

Lewis