返回列表下一主題上一主題發帖

[發問] 錄製後迴圈設定及插入複製的儲存格是否可以不插入圖案

jackson7015

中學生 Rank: 2

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2016-6-4 16:28 | 只看該作者

[發問] 錄製後迴圈設定及插入複製的儲存格是否可以不插入圖案

想請問站上的前輩們
我有一錄製的巨集想做InputBox數量迴圈
請問該如何編寫

Sub 新增數量()
Rows("1:47").Select
Selection.Copy
Rows("48:48").Select
Selection.Insert Shift:=xlDown
Range("A4").Activate
End Sub

複製代碼

還有我在上面的巨集中，負制的範圍有包含到圖片圖案
是否有不插入圖片圖案的方式
因為直接從48行插入，就不需要做行數判定，可以選擇格式設定

以上問題再請大大幫忙，感謝~

樓主熱帖

jackyq

中學生 Rank: 2

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-17

2^#

發表於 2016-6-5 18:27 | 只看該作者

有無直接的指令?  不曉得耶

用插入後再把圖刪除的方法

Sub kill_Image(R_指定範圍 As Range)

R_x1 = R_指定範圍.Left
R_x2 = R_指定範圍.Left + R_指定範圍.Width
R_y1 = R_指定範圍.Top
R_y2 = R_指定範圍.Top + R_指定範圍.Height

For Each p In R_指定範圍.Parent.Pictures
x1 = p.Left
x2 = p.Left + p.Width
y1 = p.Top
y2 = p.Top + p.Height

xx = x1 >= R_x1 And x1 <= R_x2 Or x2 >= R_x1 And x2 <= R_x2
yy = y1 >= R_y1 And y1 <= R_y2 Or y2 >= R_y1 And x2 <= R_y2

If xx And yy Then
   p.Delete
End If
Next
End Sub

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

3^#

發表於 2016-6-5 23:45 | 只看該作者

回復 1# jackson7015

Sub 新增數量()
Dim Rng As Range
Set Rng = Rows("1:47")
Rng.Copy
With Rows("48:48").Resize(, Rng.Rows.Count) 'columns/rows
      .PasteSpecial Paste:=xlPasteFormats '格式
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats '值
      .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats '公式
End With
End Sub

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

jackson7015

中學生 Rank: 2

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

4^#

發表於 2016-6-7 14:58 | 只看該作者

本帖最後由 jackson7015 於 2016-6-7 15:01 編輯

回復 2# jackyq
回復 3# ML089
感謝jackyq及ML089回覆

jackyq大大的測試後可以使用，但是需要多幾個步驟，所以之後有類似的需求可以再使用，感謝~

ML089大大的寫法，好像無法將格式所有複製，因為儲存格內文字大小及跨欄置中都沒有出現
因為有部分儲存格內有填入顏色，是否也可以以插入的方式做處理?
謝謝~

TOP

jackyq

中學生 Rank: 2

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-17

5^#

發表於 2016-6-7 16:20 | 只看該作者

回復 4# jackson7015

因為 Excel 2000 沒法用 #3樓的方法

TOP

jackyq

中學生 Rank: 2

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-17

6^#

發表於 2016-6-8 14:34 | 只看該作者

回復 4# jackson7015

大大這樣試試看吧

........
With Rows("48:48").Resize(, Rng.Rows.Count) 'columns/rows
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
Rows("48:48").PasteSpecial Paste:= 7
Rows("48:48").PasteSpecial Paste:= 13
Rows("48:48").PasteSpecial Paste:= .....  ' 逐次添加缺少的
Rows("48:48").PasteSpecial Paste:= .....  ' 逐次添加缺少的

參數自己 try
https://msdn.microsoft.com/en-us/library/bb241405%28v=office.12%29.aspx

TOP

jackson7015

中學生 Rank: 2

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

7^#

發表於 2016-6-8 15:25 | 只看該作者

回復 6# jackyq
感謝jackyq大大熱心的幫忙
7、13的確可以使用；所有格式都能[貼上]
且不會帶入圖形

可是小弟需要的功能是以插入複製儲存格的方式
這樣不用再判斷要多少格在[貼上]
因為需要的頁數每次不定
所以想要先出現InputBox詢問插入多少次
然後做迴圈式的重覆插入即可

但是錄製的時候發現[插入複製的儲存格]不能連續動作
複製一次只能插入一次，就需要再複製一次才能繼續動作
所以想請教大大是否有辦法做出連續插入儲存格(不要圖形)的方式

不然可能就要做判斷行數後，以[貼上]的方式做處理了

以上不曉得會不會說得太複雜
再請前輩們看看，感謝~

TOP

jackyq

中學生 Rank: 2

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-17

8^#

發表於 2016-6-8 17:03 | 只看該作者

回復 7# jackson7015

我知道你用 insert 是為了方便不用計算區塊大小
但 insert 好像沒有參數讓你選擇排除哪些

Sub 新增數量()

插入次數 = 5

Set R_Copy = Rows("1:47")
Set R_Insert = Rows("48:48")

For w = 1 To 插入次數
R_Copy.Select
R_Copy.Copy
R_Insert.Insert Shift:=xlDown
Next

Set R_Insert = R_Insert.Offset(-R_Copy.Rows.Count * 插入次數)
Set R_Insert = R_Insert.Resize(R_Copy.Rows.Count * 插入次數)
Call kill_Image(R_Insert)
End Sub

Sub kill_Image(ByVal R_指定範圍 As Range)

R_x1 = R_指定範圍.Left
R_x2 = R_指定範圍.Left + R_指定範圍.Width
R_y1 = R_指定範圍.Top
R_y2 = R_指定範圍.Top + R_指定範圍.Height

For Each p In R_指定範圍.Parent.Pictures
x1 = p.Left
x2 = p.Left + p.Width
y1 = p.Top
y2 = p.Top + p.Height

xx = x1 >= R_x1 And x1 <= R_x2 Or x2 >= R_x1 And x2 <= R_x2
yy = y1 >= R_y1 And y1 <= R_y2 Or y2 >= R_y1 And y2 <= R_y2

If xx And yy Then
   p.Delete
End If
Next
End Sub

TOP

jackyq

中學生 Rank: 2

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-17

9^#

發表於 2016-6-8 17:52 | 只看該作者

方法2

Sub 新增數量_2()
插入次數 = 5

Set R_Copy = Rows("1:47")
Set R_Insert = Rows("48:48")

Application.CutCopyMode = False
R_Insert.Resize(插入次數 * R_Copy.Rows.Count).Insert
R_Copy.Select
R_Copy.Copy
Set R_Insert = R_Insert.Offset(-R_Copy.Rows.Count * 插入次數)
For w = 1 To 插入次數
      R_Insert.PasteSpecial
      Set R_Insert = R_Insert.Offset(R_Copy.Rows.Count)
Next
End Sub

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

10^#

發表於 2016-6-9 00:19 | 只看該作者

回復 4# jackson7015
這樣試試

Sub 新增數量()
Dim Rng As Range
Application.DisplayAlerts = False
Set Rng = Rows("1:47")
Rng.Copy
Rows("48:48").Resize(, Rng.Rows.Count).PasteSpecial Paste:=xlPasteAll
Application.DisplayAlerts = True
End Sub

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

靜思自在 : 【生命在呼吸間】佛陀說：「生命在呼吸間。」人無法管住自己的生命，更無法擋住死期，讓自己永住人間。既然生命去來這麼無常，我們更應該好好地愛惜它、利用它、充實它，讓這無常、寶貴的生命，散發它真善美的光輝，映照出生命真正的價值。

12 下一頁

返回列表下一主題上一主題