返回列表 上一主題 發帖

[發問] 請教如何簡化指令及在如何一般模組中使用

回復 1# dino1978
必須是每個工作表都有CommandButton2 - CommandButton18的控制項
  1. Option Explicit
  2. Sub RemoveButton()
  3.     Dim I As Integer
  4.     With ActiveSheet
  5.         For I = 3 To 17
  6.             If .Cells(I, "C") <> "" Then
  7.                  .OLEObjects("CommandButton" & I - 2).Visible = True
  8.             Else
  9.                 .OLEObjects("CommandButton" & I - 2).Visible = False
  10.             End If
  11.         Next
  12.     End With
  13. End Sub
複製代碼

TOP

回復 4# dino1978
還有可簡化
  1. Private Sub CommandButton10_Click()
  2.     ASlotRemove [C12]   '傳送參數MyText : [C12]
  3. End Sub
  4. Private Sub CommandButton11_Click()
  5.     ASlotRemove [C13]   '傳送參數MyText : [C13]
  6. End Sub
  7. Private Sub CommandButton12_Click()
  8.     ASlotRemove [C14]    '傳送參數MyText : [C14]
  9. End Sub
複製代碼
  1. Sub SlotRemove(ByVal MyText As Range)   '接收參數 MyText
  2.     Application.ScreenUpdating = False
  3.     Dim Rng As Range, F_Address As String, TheFind As String, a As Range
  4.     'MyText = [C12] ' Trim(InputBox("請輸入要尋找的值:"))
  5.     If MyText <> "" Then
  6.         Set Rng = Sheet3.Range("A1").CurrentRegion.EntireColumn.Find(MyText, lookat:=xlWhole)
  7.         If Not Rng Is Nothing Then
  8.             F_Address = Rng.Address
  9.             Do
  10.                 TheFind = IIf(TheFind = "", Rng.Address(0, 0), TheFind & "   " & Rng.Address(0, 0))
  11.                 Set Rng = Sheet3.Range("A1").CurrentRegion.EntireColumn.FindNext(Rng)
  12.             Loop Until F_Address = Rng.Address
  13.         End If
  14.         Else: GoTo err2
  15.     End If
  16.     If TheFind <> "" Then
  17.         If Rng Is Nothing Then
  18.             GoTo err
  19.         Else
  20.           Sheet2.Range("A65536").End(xlUp).Offset(1) = Rng
  21.             With Rng.Resize(1, 3)
  22.                 .Delete xlShiftUp
  23.             End With
  24.             With Range("B12")
  25.                 .Resize(1, 2).ClearContents
  26.                 .ClearContents
  27.                 .Offset(, 1).Validation.Delete
  28.             End With
  29.         End If
  30.     Else
  31. err:
  32.         MsgBox "沒有找到  " & MyText
  33. err2:
  34.     End If
  35.     TheFind = ""
  36.     Application.ScreenUpdating = True
  37. End Sub
複製代碼

TOP

回復 6# dino1978
請上傳你修改後的檔案看看

TOP

回復 8# dino1978
.OLEObjects("CheckBox" & i).Value = False
改成
.OLEObjects("CheckBox" & i).Visible = False

TOP

回復 10# dino1978
OLEObjects("CheckBox" & i).Object.Value = False

TOP

        靜思自在 : 吃苦了苦、苦盡廿來,享福了福、福盡悲來。
返回列表 上一主題