Board logo

標題: 自動填滿選項按鈕 [打印本頁]
作者: caichen3    時間: 2012-3-16 14:36     標題: 自動填滿選項按鈕

請問
A1輸入資料的欄位，B1：F1有五個選項按鈕，若我想在A欄中有被輸入資料的儲存格中(A1：Ax)，B1：Bx和C1：Cx和D1：Dx和E1：Ex和F1：Fx自動會出現選項按鈕該如何？？謝謝！
作者: Hsieh    時間: 2012-3-16 20:46

  1. Sub ex()
  2. ActiveSheet.OLEObjects.Delete
  3. For Each a In Range("A:A").SpecialCells(xlCellTypeConstants)
  4.    For i = 1 To 5
  5.    With a.Offset(, i)
  6.       ActiveSheet.OLEObjects.Add ClassType:="Forms.OptionButton.1", _
  7.          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height
  8.    End With
  9.    Next
  10. Next
  11. End Sub
複製代碼
回復 1# caichen3
作者: caichen3    時間: 2012-3-16 21:25

本帖最後由 caichen3 於 2012-3-16 21:34 編輯

非常感謝Hsieh喔:)
如果希望能以5個optionbutton做為一個群組呢？？
作者: Hsieh    時間: 2012-3-16 22:18

回復 3# caichen3
  1. Sub ex()
  2. ActiveSheet.OLEObjects.Delete
  3. For Each a In Range("A:A").SpecialCells(xlCellTypeConstants)
  4.    s = 0
  5.    For i = 1 To 5
  6.    With a.Offset(, i)
  7.       Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
  8.          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
  9.          ob.Object.GroupName = "群組 " & n
  10.    End With
  11.    Next
  12.   n = n + 1
  13. Next
  14. End Sub
複製代碼
作者: caichen3    時間: 2012-3-19 11:54

非常感謝
作者: hugh0620    時間: 2012-3-19 14:39

本帖最後由 hugh0620 於 2012-3-19 15:11 編輯

回復 4# Hsieh


    H大大這一招好~  以前沒想過~  已後可以省很多時間在設定Button的時間~
   感恩唷~
作者: caichen3    時間: 2012-3-20 11:52

我在工作表新增一個按鈕，在按鈕裡輸入H大大的程式碼，執行後按鈕便消失，是不是使用OLEObject方法便無法以手動方式製作按鈕呢？？
作者: Hsieh    時間: 2012-3-20 15:15

回復 7# caichen3


    ctiveSheet.OLEObjects.Delete
就已經將所有控制項刪除
目的在怕重複執行程式，造成控制項重複新增
  1. Sub ex()
  2. Dim ob As OLEObject
  3. For Each ob In ActiveSheet.OLEObjects
  4.    If ob.progID = "Forms.OptionButton.1" Then ob.Delete
  5. Next
  6. For Each a In Range("A:A").SpecialCells(xlCellTypeConstants)
  7.    s = 0
  8.    For i = 1 To 5
  9.    With a.Offset(, i)
  10.       Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
  11.          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
  12.          ob.Object.GroupName = "群組 " & n
  13.    End With
  14.    Next
  15.   n = n + 1
  16. Next
  17. End Sub
複製代碼
作者: caichen3    時間: 2012-3-20 18:23

本帖最後由 caichen3 於 2012-3-20 18:35 編輯

感謝H大大的回覆！！還有一個問題請教你，
OLEobjects方法增加的optionbutton,每個都有編號，每次執行按鈕的編號並不是依序排列，
因為我要設定每個按鈕的標題文字，要如何以變數I來控制並設定這５個按鈕的標題文字？？
作者: Hsieh    時間: 2012-3-20 19:43

回復 9# caichen3
  1. Sub ex()
  2. Dim ob As OLEObject
  3. For Each ob In ActiveSheet.OLEObjects
  4.    If ob.progID = "Forms.OptionButton.1" Then ob.Delete
  5. Next
  6. n = 0
  7. For Each a In Range("A:A").SpecialCells(xlCellTypeConstants)
  8.    For i = 1 To 5
  9.    mystr = "選項" & n & "-" & i
  10.    With a.Offset(, i)
  11.       Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
  12.          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
  13.          ob.Object.Caption = mystr
  14.          ob.Object.GroupName = "群組 " & n
  15.    End With
  16.    Next
  17.   n = n + 1
  18. Next
  19. End Sub
複製代碼
作者: caichen3    時間: 2012-3-21 17:56

本帖最後由 caichen3 於 2012-3-21 18:06 編輯

感謝h大大:)
請教Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height是什麼意思呢？
若我在最後插入新的一列，並也希望在該列有自動新增上述所說的五個按鈕該如何呢(變數i=1 to 5) ？？
作者: hugh0620    時間: 2012-3-21 18:00

回復 11# caichen3

  讓OptionButton的大小跟你儲存格的size大小一樣大
作者: caichen3    時間: 2012-3-21 18:13

本帖最後由 caichen3 於 2012-3-21 18:25 編輯

如何設定新增按鈕的位置呢？？假設在某列的d欄至h欄中 放置5個按鈕
b為新插入的列
For i = 1 To 5
With a.Offset(, i)
      Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1")
        ob.Object.Left = ["D+b:" & "H+b"].Left
        ob.Object.Top = ["D+b:" & "H+b"].Top
        ob.Object.Width = ["D+b:" & "H+b"].Width
        ob.Object.Height = ["D+b:" & "H+b"].Height
   End With
   Next

程式碼出錯，可以幫我看看嗎？感謝
作者: hugh0620    時間: 2012-3-21 18:22

回復 13# caichen3
  1. Sub ex()
  2. Dim ob As OLEObject
  3. For Each ob In ActiveSheet.OLEObjects
  4.    If ob.progID = "Forms.OptionButton.1" Then ob.Delete
  5. Next
  6. For Each a In Range("A:A").SpecialCells(xlCellTypeConstants)
  7.    s = 0
  8.    For i = 1 To 5
  9.    With a.Offset(, i)
  10.       Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
  11.          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
  12.          ob.Top = .Top + 2       '按鈕在每個儲存格的距離top的距離
  13.          ob.Left = .Left + 10    '按鈕在每個儲存格的距離left的距離
  14.          ob.Object.GroupName = "群組 " & n
  15.    End With
  16.    Next
  17.   n = n + 1
  18. Next
  19. End Sub
複製代碼
作者: caichen3    時間: 2012-3-21 22:22

如何設定新增按鈕的位置在某列的第d欄至h欄中 放置5個按鈕
(b為新插入的列)
For i = 1 To 5
With a.Offset(, i)
      Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1")
        ob.Object.Left = ["D+b:" & "H+b"].Left
        ob.Object.Top = ["D+b:" & "H+b"].Top
        ob.Object.Width = ["D+b:" & "H+b"].Width
        ob.Object.Height = ["D+b:" & "H+b"].Height
   End With
   Next

程式碼出錯，可以幫我看看嗎？感謝
作者: Hsieh    時間: 2012-3-21 22:44

回復 15# caichen3

不知所云，甚麼叫做b是插入的列?
上傳檔案說明插入前後的狀況
作者: caichen3    時間: 2012-3-22 09:19

插入新的一列，並於該列中第d欄至h欄中放置5個選項按鈕，以下是我的部份程式碼，請大大幫我看看哪裡出錯嗎：

b = Range("I1").Value  
ActiveSheet.Rows(b).Insert   '於第b列插入新的一列
For Each a In Range("C:C").SpecialCells(xlCellTypeConstants)
   For i = 1 To 5
    Select Case i
        Case "1"
        mystr = "非常不重要" & "(" & i & ")"
        Case "2"
        mystr = "不重要" & "(" & i & ")"
        Case "3"
        mystr = "普通" & "(" & i & ")"
        Case "4"
        mystr = "重要" & "(" & i & ")"
        Case "5"
        mystr = "非常重要" & "(" & i & ")"
    End Select
   
   With a.Offset(, i)
      Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1")
          ob.Object.Left = ["D+b:" & "H+b"].Left
          ob.Object.Top = ["D+b:" & "H+b"].Top
          ob.Object.Width = ["D+b:" & "H+b"].Width
          ob.Object.Height = ["D+b:" & "H+b"].Height
          ob.Object.Caption = mystr
   End With
   Next
Next
作者: Hsieh    時間: 2012-3-22 10:45

回復 17# caichen3

你的程式碼來看
在b列插入新的一列，與新增控制項有何關係?
再猜一次看看，可能是在下移I1列的位置插入控制項吧
再無法描述清楚你的需求，可能就無能為力了
  1. Sub ex()
  2. Dim ob As OLEObject
  3. For Each ob In ActiveSheet.OLEObjects
  4.    If ob.progID = "Forms.OptionButton.1" Then ob.Delete
  5. Next
  6. For Each a In Range("A:A").SpecialCells(xlCellTypeConstants)
  7. a.Offset([I1]).EntireRow.Insert
  8.    For i = 1 To 5
  9.    mystr = IIf(i = 1, "非常不重要", IIf(i = 2, "不重要", IIf(i = 3, "普通", IIf(i = 4, "重要", "非常重要"))))
  10.    With a.Offset([I1], i)
  11.       Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
  12.          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
  13.          ob.Object.Caption = mystr
  14.          ob.Object.GroupName = "群組 " & n
  15.    End With
  16.    Next
  17. Next

  19. End Sub
複製代碼
作者: hugh0620    時間: 2012-3-22 11:02

本帖最後由 hugh0620 於 2012-3-22 11:06 編輯

回復 15# caichen3


    不要讓H大大或其他人猜測你要的結果~
    可以做一個圖例或檔案範本~
    將你要的結果~ 呈現出來~ 比較好處理唷~
作者: c_c_lai    時間: 2012-3-22 11:22

版主請教您：
我使用了   開發人員->插入->按鈕(表單控制項) ， 一個名為開啟鈕，另一個為關閉鈕。
請教您，當我想要在 EXCEL 開啟時，開啟鈕為隱藏(Hide)模式，當我選按關閉鈕時，
開啟鈕就顯示出來(Enable)，關閉鈕就同時變更為隱藏(Hide)模式，反之亦然。
因為我在VBA編輯器內，不知要如何得知這些按鈕的Object Name，以及能否使用
Enable或Disable語法，勝至還想將'開啟'字句改為其他字語或變更顏色等等，在此謝謝您了！
作者: caichen3    時間: 2012-3-22 11:45

非常感謝各位大大的回覆，以後我的提問會更清楚說明一些
以下是我要呈現的畫片結果
A欄：編號   B欄：使用者需求敘述  C欄：空儲存格   D~H欄：放置OptionButton ，每一列為一個群組，並以編號1~5依序排列(OptionButton以OB表示)
      A      B       C          D               E              F                G              H
1   1     xxx             OB0-1     OB0-2     OB0-3      OB0-4     OB0-5
2   2     yyy             OB1-1     OB1-2     OB1-3      OB1-4     OB1-5
3   3     zzz             OB2-1     OB2-2     OB2-3      OB2-4     OB2-5
4   4      jjj               OB3-1     OB3-2     OB3-3      OB3-4     OB3-5
5   5      iii               OB4-1     OB4-2     OB4-3      OB4-4     OB4-5
6
7

如果我想要插入新的一列，並且希望能在該列上新增OptionButton，像上述以編號1~5呈現，但原先的工作表上已被選取的OptionButton資料不會被清除呢？？
作者: Hsieh    時間: 2012-3-22 13:47

本帖最後由 Hsieh 於 2012-3-26 14:01 編輯

回復 21# caichen3
  1. Sub Add_Opt()
  2. Dim ob As OLEObject, Rng As Range, A As Range, B As Range
  3. n = 0
  4. For Each ob In ActiveSheet.OLEObjects
  5. Set A = ob.TopLeftCell
  6.     If Rng Is Nothing Then
  7.       Set Rng = ob.TopLeftCell.EntireRow
  8.       n = 1
  9.       ElseIf Intersect(Rng, ob.TopLeftCell) Is Nothing Then
  10.       Set Rng = Union(Rng, ob.TopLeftCell.EntireRow)
  11.       n = n + 1
  12.     End If
  13. Next
  14. For Each A In Range("A:A").SpecialCells(xlCellTypeConstants)
  15. Set B = Nothing
  16. If Not Rng Is Nothing Then Set B = Intersect(A, Rng)
  17. If B Is Nothing Then
  18.    n = n + 1
  19.    mystr = "OB" & n & "-"
  20.    For i = 1 To 5
  21.    cap = mystr & i
  22.    With A.Offset(, i + 1)
  23.       Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
  24.          Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
  25.          ob.Object.Caption = cap
  26.          ob.Object.GroupName = "群組 " & n
  27.    End With
  28.    Next
  29. End If
  30. Next
  31. End Sub
複製代碼
作者: caichen3    時間: 2012-3-22 15:12

誠心感謝H大大的幫忙，解決我的難題，真的非常感謝你！！
作者: caichen3    時間: 2012-4-9 14:00

拜託H大大可以幫我看看{新增}按鈕程式碼的部份嗎？？
如果我按過{刪除}按鈕，再緊接著按{新增}按鈕，
新增的選項按鈕的群組就會重複！！(n：群組號碼)
一直找不出是哪裡出了問題@@
作者: GBKEE    時間: 2012-4-9 16:10

本帖最後由 GBKEE 於 2012-4-9 16:15 編輯

回復 24# caichen3
試試看
  1. Option Explicit
  2. Private Sub CommandButton4_Click()
  3.     Dim xR As Integer, Ar(1 To 5), xi As Integer, OB As OLEObject
  4.     With ActiveSheet
  5.         .CommandButton4.Placement = xlFreeFloating
  6.         xR = .Cells(Rows.Count, "A").End(xlUp).Row         'A欄最後有資料的列號
  7.         Ar(1) = xR & "非常不重要" & "(" & xR & ")"
  8.         Ar(2) = xR & "不重要" & "(" & xR & ")"
  9.         Ar(3) = xR & "普通" & "(" & xR & ")"
  10.         Ar(4) = xR & "重要" & "(" & xR & ")"
  11.         Ar(5) = xR & "非常重要" & "(" & xR & ")"
  12.         For xi = 1 To 5
  13.             With .Cells(xR + 1, "A").Offset(, xi + 2)      '以A欄為主   最後有資料的列號 + 1列的位置
  14.                 Set OB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
  15.                 OB.Object.Caption = Ar(xi)
  16.                 OB.Object.GroupName = "Row" & xR + 1   '對應列號
  17.             End With
  18.          Next
  19.         With .Range(.Cells(2, "A"), .Cells(xR + 1, "A")).Resize(, 8) 'A2:H & xR + 1
  20.             .Columns(1) = "=row()-1"                                 'A欄公式 依列號-1
  21.             .Columns(1) = .Columns(1).Value                           '將公式 轉成 值
  22.             .Columns(1).Interior.ColorIndex = 15
  23.             .Borders.LineStyle = xlContinuous
  24.             .Borders(xlEdgeBottom).Weight = xlThick
  25.             .Borders(xlEdgeRight).Weight = xlThick
  26.             .Borders(xlEdgeLeft).Weight = xlThick
  27.         End With
  28.     End With
  29. End Sub
  30. Private Sub CommandButton5_Click()
  31.     Dim xR As Integer, OB As OLEObject, Sp As Variant, MyStr As String
  32.     With ActiveSheet
  33.         .CommandButton5.Placement = xlFreeFloating
  34.          If ActiveCell.Row > .Cells(Rows.Count, "A").End(xlUp).Row Then Exit Sub  '不是範圍中
  35.         xR = ActiveCell.Row                                          '取得 作用儲存格的列號
  36.         For Each OB In ActiveSheet.OLEObjects
  37.             If OB.Name Like "OptionButton*" Then
  38.                 If OB.Object.GroupName = "Row" & xR Then OB.Delete  '刪除作用儲存格的列號 群組
  39.             End If
  40.         Next
  41.         .Cells(xR, "A").Resize(, 8).Delete xlUp                      '刪除作用儲存格 A欄到H欄
  42.         xR = .Cells(Rows.Count, "A").End(xlUp).Row
  43.         With .Range(.Cells(2, "A"), .Cells(xR, "A")).Resize(, 8)     'A2:H & xR :範圍中
  44.             .Columns(1) = "=row()-1"
  45.             .Columns(1) = .Columns(1).Value
  46.             .Columns(1).Interior.ColorIndex = 15
  47.             .Borders.LineStyle = xlContinuous
  48.             .Borders(xlEdgeBottom).Weight = xlThick
  49.             .Borders(xlEdgeRight).Weight = xlThick
  50.             .Borders(xlEdgeLeft).Weight = xlThick
  51.         End With
  52.         For Each OB In .OLEObjects                      '重新配置 OptionButton的文字 及 GroupName
  53.             If OB.Name Like "OptionButton*" Then
  54.                 Sp = Split(OB.TopLeftCell.Address(), "$")  '拆解 OptionButton 所在絕對位 置例: $D$5
  55.                 Select Case Sp(1)
  56.                     Case "D"
  57.                         MyStr = "非常不重要"
  58.                     Case "E"
  59.                         MyStr = "不重要"
  60.                     Case "F"
  61.                         MyStr = "普通"
  62.                     Case "G"
  63.                         MyStr = "重要"
  64.                     Case "H"
  65.                         MyStr = "非常重要"
  66.                 End Select
  67.                 OB.Object.Caption = Sp(2) - 1 & MyStr & "(" & Sp(2) - 1 & ")"
  68.                 OB.Object.GroupName = "Row" & Sp(2)    '對應列號
  69.             End If
  70.         Next
  71.     End With
  72. End Sub
複製代碼
作者: caichen3    時間: 2012-4-10 12:02

謝謝大大的幫助，還細心的提供說明註解，讓我清楚程式的整體架構，感謝喔



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)