caichen3

«D±`·PÁ¦U¦ì¤j¤jªº¦^ÂСA¥H«á§Úªº´£°Ý·|§ó²M·¡»¡©ú¤@¨Ç
¥H¤U¬O§Ú­n§e²{ªºµe¤ùµ²ªG
AÄæ¡G½s¸¹   BÄæ¡G¨Ï¥ÎªÌ»Ý¨D±Ô­z  CÄæ¡GªÅÀx¦s®æ   D~HÄæ¡G©ñ¸mOptionButton ¡A¨C¤@¦C¬°¤@­Ó¸s²Õ¡A¨Ã¥H½s¸¹1~5¨Ì§Ç±Æ¦C(OptionButton¥HOBªí¥Ü)
      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

¦pªG§Ú·Q­n´¡¤J·sªº¤@¦C¡A¨Ã¥B§Æ±æ¯à¦b¸Ó¦C¤W·s¼WOptionButton¡A¹³¤W­z¥H½s¸¹1~5§e²{¡A¦ý­ì¥ýªº¤u§@ªí¤W¤w³Q¿ï¨úªºOptionButton¸ê®Æ¤£·|³Q²M°£©O¡H¡H

Hsieh

¦^´_ 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 = "¸s²Õ " & n
    
27.    End With
    
28.    Next
    
29. End If
    
30. Next
    
31. End Sub

½Æ»s¥N½X

caichen3

¸Û¤ß·PÁÂH¤j¤jªºÀ°¦£¡A¸Ñ¨M§ÚªºÃøÃD¡A¯uªº«D±`·PÁ§A¡I¡I

caichen3

«ô°UH¤j¤j¥i¥HÀ°§Ú¬Ý¬Ý{·s¼W}«ö¶sµ{¦¡½Xªº³¡¥÷¶Ü¡H¡H
¦pªG§Ú«ö¹L{§R°£}«ö¶s¡A¦Aºò±µµÛ«ö{·s¼W}«ö¶s¡A
·s¼Wªº¿ï¶µ«ö¶sªº¸s²Õ´N·|­«½Æ¡I¡I(n¡G¸s²Õ¸¹½X)
¤@ª½§ä¤£¥X¬O­þ¸Ì¥X¤F°ÝÃD@@

GBKEE

¦^´_ 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Äæ³Ì«á¦³¸ê®Æªº¦C¸¹
   
7.         Ar(1) = xR & "«D±`¤£­«­n" & "(" & xR & ")"
   
8.         Ar(2) = xR & "¤£­«­n" & "(" & xR & ")"
   
9.         Ar(3) = xR & "´¶³q" & "(" & xR & ")"
   
10.         Ar(4) = xR & "­«­n" & "(" & xR & ")"
    
11.         Ar(5) = xR & "«D±`­«­n" & "(" & xR & ")"
    
12.         For xi = 1 To 5
    
13.             With .Cells(xR + 1, "A").Offset(, xi + 2)      '¥HAÄ欰¥D   ³Ì«á¦³¸ê®Æªº¦C¸¹ + 1¦Cªº¦ì¸m
    
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   '¹ïÀ³¦C¸¹
    
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Ä椽¦¡ ¨Ì¦C¸¹-1
    
21.             .Columns(1) = .Columns(1).Value                           '±N¤½¦¡ Âন ­È
    
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  '¤£¬O½d³ò¤¤
    
35.         xR = ActiveCell.Row                                          '¨ú±o §@¥ÎÀx¦s®æªº¦C¸¹
    
36.         For Each OB In ActiveSheet.OLEObjects
    
37.             If OB.Name Like "OptionButton*" Then
    
38.                 If OB.Object.GroupName = "Row" & xR Then OB.Delete  '§R°£§@¥ÎÀx¦s®æªº¦C¸¹ ¸s²Õ
    
39.             End If
    
40.         Next
    
41.         .Cells(xR, "A").Resize(, 8).Delete xlUp                      '§R°£§@¥ÎÀx¦s®æ 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 :½d³ò¤¤
    
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                      '­«·s°t¸m OptionButtonªº¤å¦r ¤Î GroupName
    
53.             If OB.Name Like "OptionButton*" Then
    
54.                 Sp = Split(OB.TopLeftCell.Address(), "$")  '©î¸Ñ OptionButton ©Ò¦bµ´¹ï¦ì ¸m¨Ò: $D$5
    
55.                 Select Case Sp(1)
    
56.                     Case "D"
    
57.                         MyStr = "«D±`¤£­«­n"
    
58.                     Case "E"
    
59.                         MyStr = "¤£­«­n"
    
60.                     Case "F"
    
61.                         MyStr = "´¶³q"
    
62.                     Case "G"
    
63.                         MyStr = "­«­n"
    
64.                     Case "H"
    
65.                         MyStr = "«D±`­«­n"
    
66.                 End Select
    
67.                 OB.Object.Caption = Sp(2) - 1 & MyStr & "(" & Sp(2) - 1 & ")"
    
68.                 OB.Object.GroupName = "Row" & Sp(2)    '¹ïÀ³¦C¸¹
    
69.             End If
    
70.         Next
    
71.     End With
    
72. End Sub

½Æ»s¥N½X

caichen3

ÁÂÁ¤j¤jªºÀ°§U¡AÁٲӤߪº´£¨Ñ»¡©úµù¸Ñ¡AÅý§Ú²M·¡µ{¦¡ªº¾ãÅé¬[ºc¡A·PÁ³á