帖子: 80
主題: 27
精華: 0
積分: 108
點名: 0
作業系統: windows
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-3-6
最後登錄: 2012-8-23

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 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

當我在所在列按下「插入」，所在列本來的核取方塊並不會往下移，而是在下一列新增核取方塊是為什麼呢？？

6-11(new).rar (113.44 KB)

樓主熱帖

寶寶

kimbal

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 472
主題: 5
精華: 0
積分: 485
點名: 0
作業系統: Windows
軟體版本: MS Office
閱讀權限: 100
性別: 男
來自: 香港
註冊時間: 2010-7-4
最後登錄: 2014-12-28

論壇貢獻勳章

2^#

發表於 2012-5-22 14:00 | 只看該作者

先回一下"第2/3個"問題
2. 把現時選上的row和checkbox delete (checkbox 用top來定位)

Dim objCurrRow As Object
Dim intCurrTop As Long
Dim intNextTop As Long
With Selection
intCurrTop = .Top
intNextTop = .Offset(1, 0).Top
End With
For Each s In ActiveSheet.Shapes
If s.Top >= intCurrTop And s.Top < intNextTop And Left(s.Name, 8) = "CheckBox" Then
s.Delete
End If
Next
Selection.EntireRow.Delete

複製代碼

3.
"當我在所在列按下「插入」，所在列本來的核取方塊並不會往下移，而是在下一列新增核取方塊是為什麼呢？？"
把
k = gyou + 1
換成
k = gyou
試試...

懂得發問,答案就會在其中

今日の一秒は明日にない
http://kimbalko-chi.blogspot.com
http://kimbalko.blogspot.com

TOP

caichen3

中學生 Rank: 2

帖子: 80
主題: 27
精華: 0
積分: 108
點名: 0
作業系統: windows
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2012-3-6
最後登錄: 2012-8-23

3^#

發表於 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

希望是將所在列以下(包括所在列)的控制項全部往下移一列

寶寶

TOP

oobird

　頭銜: 街友一族

超級版主 Rank: 8 Rank: 8

帖子: 1572
主題: 16
精華: 2
積分: 1521
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 150
性別: 男
註冊時間: 2010-5-1
最後登錄: 2016-1-13

論壇貢獻勳章

4^#

發表於 2012-5-23 13:32 | 只看該作者

Sub yy()
r = ActiveCell.Row'所在列
For Each s In ActiveSheet.Shapes
If s.TopLeftCell.Row >= r Then
h = s.TopLeftCell.RowHeight'取得列高
s.Top = s.Top + h
End If
Next
End Sub

複製代碼

TOP