[發問] 隨心所欲新增列與控制項

caichen3

請教大大們~
若想要在目前儲存格按下「插入」按鈕，會插入新的一列，並且在新的一列中會新增一列核取方塊？
在目前儲存格按下「刪除」按鈕，會刪除整列包括所在列的核取方塊？？
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

先回一下"第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

感謝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

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

複製代碼