- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
25#
發表於 2012-4-9 16:10
| 只看該作者
本帖最後由 GBKEE 於 2012-4-9 16:15 編輯
回復 24# caichen3
試試看- Option Explicit
- Private Sub CommandButton4_Click()
- Dim xR As Integer, Ar(1 To 5), xi As Integer, OB As OLEObject
- With ActiveSheet
- .CommandButton4.Placement = xlFreeFloating
- xR = .Cells(Rows.Count, "A").End(xlUp).Row 'A欄最後有資料的列號
- Ar(1) = xR & "非常不重要" & "(" & xR & ")"
- Ar(2) = xR & "不重要" & "(" & xR & ")"
- Ar(3) = xR & "普通" & "(" & xR & ")"
- Ar(4) = xR & "重要" & "(" & xR & ")"
- Ar(5) = xR & "非常重要" & "(" & xR & ")"
- For xi = 1 To 5
- With .Cells(xR + 1, "A").Offset(, xi + 2) '以A欄為主 最後有資料的列號 + 1列的位置
- Set OB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
- OB.Object.Caption = Ar(xi)
- OB.Object.GroupName = "Row" & xR + 1 '對應列號
- End With
- Next
- With .Range(.Cells(2, "A"), .Cells(xR + 1, "A")).Resize(, 8) 'A2:H & xR + 1
- .Columns(1) = "=row()-1" 'A欄公式 依列號-1
- .Columns(1) = .Columns(1).Value '將公式 轉成 值
- .Columns(1).Interior.ColorIndex = 15
- .Borders.LineStyle = xlContinuous
- .Borders(xlEdgeBottom).Weight = xlThick
- .Borders(xlEdgeRight).Weight = xlThick
- .Borders(xlEdgeLeft).Weight = xlThick
- End With
- End With
- End Sub
- Private Sub CommandButton5_Click()
- Dim xR As Integer, OB As OLEObject, Sp As Variant, MyStr As String
- With ActiveSheet
- .CommandButton5.Placement = xlFreeFloating
- If ActiveCell.Row > .Cells(Rows.Count, "A").End(xlUp).Row Then Exit Sub '不是範圍中
- xR = ActiveCell.Row '取得 作用儲存格的列號
- For Each OB In ActiveSheet.OLEObjects
- If OB.Name Like "OptionButton*" Then
- If OB.Object.GroupName = "Row" & xR Then OB.Delete '刪除作用儲存格的列號 群組
- End If
- Next
- .Cells(xR, "A").Resize(, 8).Delete xlUp '刪除作用儲存格 A欄到H欄
- xR = .Cells(Rows.Count, "A").End(xlUp).Row
- With .Range(.Cells(2, "A"), .Cells(xR, "A")).Resize(, 8) 'A2:H & xR :範圍中
- .Columns(1) = "=row()-1"
- .Columns(1) = .Columns(1).Value
- .Columns(1).Interior.ColorIndex = 15
- .Borders.LineStyle = xlContinuous
- .Borders(xlEdgeBottom).Weight = xlThick
- .Borders(xlEdgeRight).Weight = xlThick
- .Borders(xlEdgeLeft).Weight = xlThick
- End With
- For Each OB In .OLEObjects '重新配置 OptionButton的文字 及 GroupName
- If OB.Name Like "OptionButton*" Then
- Sp = Split(OB.TopLeftCell.Address(), "$") '拆解 OptionButton 所在絕對位 置例: $D$5
- Select Case Sp(1)
- Case "D"
- MyStr = "非常不重要"
- Case "E"
- MyStr = "不重要"
- Case "F"
- MyStr = "普通"
- Case "G"
- MyStr = "重要"
- Case "H"
- MyStr = "非常重要"
- End Select
- OB.Object.Caption = Sp(2) - 1 & MyStr & "(" & Sp(2) - 1 & ")"
- OB.Object.GroupName = "Row" & Sp(2) '對應列號
- End If
- Next
- End With
- End Sub
|
|
發表於 2012-3-22 11:45
| 
