我有一個檔案，您可以在其中移動或復制一行，有一個“移動”和“復制”按鈕，都是切換按鈕
'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
而這些就是功能。
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
我想避免復制/移動空行，也不想用資料覆寫一行（或至少給出警告）。請參閱代碼中的 msgbox。我可以使用什么屬性來更改它，以便在第一次單擊后，按鈕回傳“已釋放”狀態？當我只執行“value = false”時，再次觸發點擊事件。如果“簡單”按鈕而不是 Active X 切換按鈕是一種解決方案，那么該解決方案也將非常棒。只是為了可用性，它采用了這個切換按鈕。感謝您的輸入。
PS：我也更愿意將按鈕本身傳遞給公式，而不是我必須檢查的布林值。
uj5u.com熱心網友回復：
同時我找到了一個（臨時的？）解決方案，再次呼叫按鈕的點擊事件，這樣按鈕就會回到“釋放”模式。這是（一個按鈕）代碼：
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
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/364872.html