- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
2#
發表於 2012-4-29 11:47
| 只看該作者
本帖最後由 GBKEE 於 2012-4-29 13:48 編輯
回復 1# caichen3
請新增一般模組
於頂端 輸入- Option Explicit
- Public Const OB_Caption1 = "功能性需求"
- Public Const OB_Caption2 = "感官性需求"
- Public Const OB_Caption3 = "隱藏性需求"
- Private Sub CommandButton1_Click() '客戶的真正需求輸入
- Dim OB As OLEObject, k As Integer, xR As Integer
- If ComboBox1.ListIndex = -1 Then Exit Sub 'ComboBox1 的值不在清單內
- With ActiveSheet
- .UsedRange.Offset(11) .Clear '第12列以下的儲存格 '清除內容
- With .[A12:F12].Resize(ComboBox1.Value) '第12列以下的儲存格 擴充為ComboBox1.Value 的列數範圍
- .Borders.LineStyle = xlContinuous
- .Borders.ColorIndex = 1
- End With
- For Each OB In ActiveSheet.OLEObjects
- If OB.progID = "Forms.CheckBox.1" Then
- If OB.TopLeftCell.Row > 11 Then OB.Delete
- End If
- Next
- For k = 1 To ComboBox1.Value
- .Cells(11 + k, "C") = k
- For xR = 0 To 2
- With .Cells(11 + k, "d").Offset(, xR) '從 第11後 開使
- Set OB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
- OB.Object.Caption = IIf(xR = 0, OB_Caption1, IIf(xR = 1, OB_Caption2, OB_Caption3))
- OB.Object.GroupName = .Row '以列號為群組名稱
- If OB.Object.Caption = OB_Caption3 Then OB.Object.BackColor = &H80FFFF
- End With
- Next
- Next
- End With
- Unload UserForm1
- End Sub
- Private Sub CommandButton2_Click() '刪除
- Dim xR As Integer, OB As OLEObject
- With ActiveSheet
- If ActiveCell.Row > Cells(Rows.Count, "C").End(xlUp).Row Or ActiveCell.Row <= 11 Then Exit Sub
- xR = ActiveCell.Row
- For Each OB In ActiveSheet.OLEObjects
- If OB.Name Like "CheckBox*" Then
- If OB.TopLeftCell.Row = xR Then OB.Delete 'TopLeftCell.Row 控制項所在的位置.列號
- End If
- Next
- .Cells(xR, "A").Resize(, 6).Delete xlUp
- For Each OB In ActiveSheet.OLEObjects
- If OB.Name Like "CheckBox*" Then
- If OB.TopLeftCell.Row >= xR Then
- '>=TopLeftCell.Row 控制項所在的位置.列號 才需重新整理 群組名稱
- OB.Object.GroupName = OB.TopLeftCell.Row
- .Cells(OB.TopLeftCell.Row, "C") = OB.TopLeftCell.Row - 11
- '設置 C欄的數字
- End If
- End If
- Next
- End With
- End Sub
- Private Sub CommandButton4_Click() '新增
- Dim xR As Range, xi As Integer
- With ActiveSheet
- Set xR = .Cells(Rows.Count, "C").End(xlUp).Offset(1) 'C欄的數字最後有一個資料的儲存格 往下一列
- If xR.Row <= 11 Then Set xR = .Cells(12, "C")
- xR = xR.Row - 11 ' 給值 : 從第11 列開始
- For xi = 1 To 3
- With xR.Offset(, xi)
- Set OB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
- OB.Object.Caption = IIf(xi = 1, OB_Caption1, IIf(xi = 2, OB_Caption2, OB_Caption3))
- OB.Object.GroupName = xR.Row '對應列號
- If OB.Object.Caption = OB_Caption3 Then OB.Object.BackColor = &H80FFFF
- End With
- Next
- With .Range(Cells(xR.Row, "A"), .Cells(xR.Row, "F"))
- .Borders.LineStyle = xlContinuous
- .Borders(xlEdgeRight).ColorIndex = 1
- End With
- End With
- End Sub
|
|
發表於 2012-4-26 13:39
| 
