- 帖子
- 559
- 主題
- 58
- 精華
- 0
- 積分
- 626
- 點名
- 0
- 作業系統
- win8
- 軟體版本
- office2013
- 閱讀權限
- 50
- 性別
- 男
- 來自
- TW
- 註冊時間
- 2010-11-22
- 最後登錄
- 2024-6-14
|
6#
發表於 2011-6-27 16:04
| 只看該作者
回復 5# oobird
大大
後來~ 我使用IF P.TYPE<>13 THEN GOTO的方式,排除掉問題
下面的程式碼修改/執行後沒有問題
A = Sheet1.Range("C65536").End(xlUp).Row
Sheet1.Rows("2:" & A).RowHeight = 81
Sheet1.Columns("E:E").ColumnWidth = 12.88
Dim p As Shape
With Sheet1
For Each p In .Shapes
If p.Type <> 13 Then GoTo 1
R = R + 1
p.Name = R
1
Next
For Each p In .Shapes
If p.Type <> 13 Then GoTo 2
R = p.TopLeftCell.Row
p.Name = .Cells(R, 3).Value
p.Top = .Cells(R, 5).Top
p.Left = .Cells(R, 5).Left
p.LockAspectRatio = msoFalse
p.Height = 75
p.Width = 73.5
2
Next
End With
With Sheet2
'====問題點=========
For Each shp In .Shapes
If shp.Type = 13 Then shp.Delete
Next
'====問題點=========
Do Until .Range("C" & 3 + K) = ""
x = .Range("C" & 3 + K).Value
Sheet1.Shapes(x).Copy
.Select
.Paste
Selection.Top = .Range("d" & 3 + K).Top
Selection.Left = .Range("d" & 3 + K).Left
K = K + 1
Loop |
|