Home > Back-end >  VBA change state of toggle button
VBA change state of toggle button

Time:11-24

I have a document where you can move or copy a row, there is a "move" and "copy" button, both are toggle buttons enter image description here

'VARIABLES    
Const sSTARTROW As String = "A"
Const sENDROW As String = "O"
Const sMOVEBUTTON As String = "Move line"
Const sCOPYBUTTON As String = "Copy line" 
Dim sClipboard() As String
Dim iRowNumberBackup As Integer


Private Sub MoveButton_Click()
        Dim sRange As String
        Dim rDataRange As Range
    
        Select Case MoveButton.Value
            'pushed
            Case True
                GetData ActiveCell.Row, False
            'released
            Case False
                DropData ActiveCell.Row
        End Select
    End Sub
    
    Private Sub CopyButton_Click()
        Select Case CopyButton.Value
            'pushed
            Case True
                GetData ActiveCell.Row, True
            'released
            Case False
                DropData ActiveCell.Row
        End Select
    End Sub

And these are the functions.

Function GetData(iRowNumber As Integer, bCopy As Boolean)
    Dim cell As Range
    'set the row number were data was taken from to set back in case of emergency
    iRowNumberBackup = iRowNumber
    'create the range that needs to be moved
    sRange = sSTARTROW & iRowNumber & ":" & sENDROW & iRowNumber
    'copy value into dynamic range
    Set rDataRange = Range(sRange)
    'if the line is empty stop everything
    If rDataRange(1, 1) = 0 Then
        MsgBox ("empty line")
        Exit Function
    End If
    'define array size depending the size of range
    ReDim sClipboard(rDataRange.Columns.Count)
    'put the value of range into the array
    Dim i As Integer: i = 0
    For Each cell In rDataRange.Cells
        sClipboard(i) = cell.Value
        i = i   1
    Next cell
    'check if it's copy or move
    Select Case bCopy
        Case True
            'change button description
            CopyButton.Caption = sClipboard(0) & " - " & sClipboard(1) & " (" & sClipboard(2) & ")"
        Case False
            'remove data that was placed in the array
            Range(sRange).ClearContents
            'change button description
            MoveButton.Caption = sClipboard(0) & " - " & sClipboard(1) & " (" & sClipboard(2) & ")"
    End Select
End Function

.

Function DropData(iRowNumber As Integer)
    Dim cell As Range
    'create the range that needs to be moved
    sRange = sSTARTROW & iRowNumber & ":" & sENDROW & iRowNumber
    'set the new range
    Set rDataRange = Range(sRange)
    'if the line is already with data set back in previous row where it was copied & stop everything
    If rDataRange(1, 1) <> 0 Then
        MsgBox ("Data already in this line")
        DropData (iRowNumberBackup)
        Exit Function
    End If
    'copy value from the array into the selected range
    Dim i As Integer: i = 0
    For Each cell In rDataRange.Cells
        cell.Value = sClipboard(i)
        i = i   1
    Next cell
    'empty array
    Erase sClipboard
    'change button description
    MoveButton.Caption = sMOVEBUTTON
    CopyButton.Caption = sCOPYBUTTON
End Function

I would like to avoid copying / moving empty lines, as well as not overwriting a line with data yet (or at least give a warning). See msgbox in the code. What property can I use to change it so after the first click, the button goes back into the "released" state ? When I do just "value = false" the click event is triggered again. If a "simple" button instead of a Active X toggle button is a solution, this solution would also be great. It's just for usability it took this toggle button. Thanks for your input.

PS: also I would prefer to pass the button itself to the formula instead of a boolean where I have to do a check.

CodePudding user response:

Meanwhile I found a (temporary?) solution, to call again the click event of the button, this way the button is back in "released" mode. Here's (for one button) the code:

Sub MoveButton_Click()
    'check for avoiding endless loop
    If Not bEmptyline Then
        Dim sRange As String
        Dim rDataRange As Range
        DisableOtherButton (False)
        Select Case MoveButton.Value
            'clicked
            Case True
                GetData ActiveCell.Row, False
            'released
            Case False
                DropData ActiveCell.Row
        End Select
    End If
End Sub

.

Function GetData(iRowNumber As Integer, bCopy As Boolean)
    Dim cell As Range
    'set the row number were data was taken from to set back in case of emergency
    iRowNumberBackup = iRowNumber
    'create the range that needs to be moved
    sRange = sSTARTROW & iRowNumber & ":" & sENDROW & iRowNumber
    'copy value into dynamic range
    Set rDataRange = Range(sRange)
    'if the line is empty stop everything
    If rDataRange(1, 1) = 0 Then
        EmptyLine (bCopy)
        Exit Function
    End If
    'define array size depending the size of range
    ReDim sClipboard(rDataRange.Columns.Count)
    'put the value of range into the array
    Dim i As Integer: i = 0
    For Each cell In rDataRange.Cells
        sClipboard(i) = cell.Value
        i = i   1
    Next cell
    'check if it's copy or move
    Select Case bCopy
        Case True
            'change button description
            CopyButton.Caption = sClipboard(0) & " - " & sClipboard(1) & " (" & sClipboard(2) & ")"
        Case False
            'remove data that was placed in the array
            Range(sRange).ClearContents
            'change button description
            MoveButton.Caption = sClipboard(0) & " - " & sClipboard(1) & " (" & sClipboard(2) & ")"
    End Select
End Function

.

Function EmptyLine(bCopy As Boolean)
    whatever = MsgBox("Empty row selected.", vbInformation)
    'change empty line to avoid endless loop (for every time click event)
    bEmptyline = True
    'recall click to set button back to standard state (not clicked but released), BETTER SOLUTION ???
    Select Case bCopy
        'coming from the copy button
        Case True
            CopyButton.Value = Not CopyButton.Value
            Sheet1.CopyButton_Click
        'coming from the move button
        Case False
            MoveButton.Value = Not MoveButton.Value
            Sheet1.MoveButton_Click
    End Select
    'set back to false for next time
    bEmptyline = False
End Function 
  • Related