Board logo

標題: [發問] 隨心所欲新增列與控制項 [打印本頁]
作者: caichen3    時間: 2012-5-22 13:32     標題: 隨心所欲新增列與控制項

請教大大們~
若想要在目前儲存格按下「插入」按鈕，會插入新的一列，並且在新的一列中會新增一列核取方塊？
在目前儲存格按下「刪除」按鈕，會刪除整列包括所在列的核取方塊？？
Private Sub 插入_Click()
Dim i As Integer
Dim k As Integer
Dim ob As OLEObject
Dim xR  As Range

With ActiveSheet
gyou = Selection.Row
ActiveSheet.Rows(gyou ).Insert
Range("M1").Value = Range("M1").Value + 1

k = gyou + 1
Set xR = Cells(k, 3)
For i = 1 To 3
    Select Case i
        Case "1"
        mystr = "功能性需求"
        Case "2"
        mystr = "感官性需求"
        Case "3"
        mystr = "隱藏需求"
    End Select
   
    With xR.Offset(, i)
         Set ob = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
         ob.Object.Caption = mystr
    End With
Next

End With
End Sub

當我在所在列按下「插入」，所在列本來的核取方塊並不會往下移，而是在下一列新增核取方塊是為什麼呢？？
作者: kimbal    時間: 2012-5-22 14:00

先回一下"第2/3個"問題
2. 把現時選上的row和checkbox delete (checkbox 用top來定位)
  1.     Dim objCurrRow As Object
  2.     Dim intCurrTop As Long
  3.     Dim intNextTop As Long
  4.     With Selection
  5.         intCurrTop = .Top
  6.         intNextTop = .Offset(1, 0).Top
  7.     End With
  8.    
  9.     For Each s In ActiveSheet.Shapes
  10.         If s.Top >= intCurrTop And s.Top < intNextTop And Left(s.Name, 8) = "CheckBox" Then
  11.             s.Delete
  12.         End If
  13.     Next
  14.     Selection.EntireRow.Delete
複製代碼
3.
"當我在所在列按下「插入」，所在列本來的核取方塊並不會往下移，而是在下一列新增核取方塊是為什麼呢？？"
把
k = gyou + 1
換成
k = gyou
試試...
作者: caichen3    時間: 2012-5-23 12:48

感謝k大大的幫助
有沒有什麼方法可將控制項往下移呢？  
Dim objCurrRow As Object
Dim intCurrTop As Long
With Selection
        intCurrTop = .Top
End With
   
For Each s In ActiveSheet.Shapes
        If s.Top >= intCurrTop Then
            s.offset(1,0)
        End If
Next

希望是將所在列以下(包括所在列)的控制項全部往下移一列
作者: oobird    時間: 2012-5-23 13:32

  1. Sub yy()
  2.     r = ActiveCell.Row'所在列
  3.     For Each s In ActiveSheet.Shapes
  4.         If s.TopLeftCell.Row >= r Then
  5.             h = s.TopLeftCell.RowHeight'取得列高
  6.            s.Top = s.Top + h
  7.         End If
  8.     Next
  9. End Sub
複製代碼




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