返回列表 上一主題 發帖

[發問] 如何只複製一個定義名稱內的框線格式(例如只包含linestyle,colorindex,weight)?

swatt

帖子
37 
主題
11 
精華
0 
積分
87 
點名
0  
作業系統
window7 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-3-14 
最後登錄
2022-5-30 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-8-22 11:14 | 只看該作者

[發問] 如何只複製一個定義名稱內的框線格式(例如只包含linestyle,colorindex,weight)?

各位高手大大,
如題,
在一個sheet內有多筆相同範圍的定義名稱，先會在第一個定義名稱內畫好框線，目標是將畫好的框線格式複製給其他定義名稱。
起初想用手動pasteformat但發現會把底色資料貼上去，無法只畫框線。後來搜尋資料發現以下語法可用
ActiveCell.Offset(0, 5).Borders().LineStyle = ActiveCell.Borders().LineStyle
所以稍微做個實驗改變如下, c4:D5是有畫框線的，要將其框線格式複製給沒畫框線的a1:b2 ，
ActiveSheet.Range("a1:B2").Borders().LineStyle = ActiveSheet.Range("c4:D5").Borders().LineStyle
結果卻無法執行!!!! 不知問題出在哪裡?

請問各位高手大大，是否還有其他方式可以只複製框線格式，然後貼給相同大小範圍的range??
收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
256  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-26 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-8-22 15:10 | 只看該作者
回復 1# swatt
要每條格線逐一設定
  1. Sub nn()
  2. Dim Rng As Range, Rng1 As Range
  3. Set Rng = Range("C4:D5") '來源範圍
  4. Set Rng1 = Range("A1:B2") '改變範圍
  5. Rng1.ClearFormats
  6. For i = 1 To Rng.Rows.Count
  7.    For j = 1 To Rng.Columns.Count
  8.      For k = 1 To Rng.Borders.Count
  9.        Rng1(i, j).Borders(k).Weight = Rng(i, j).Borders(k).Weight
  10.        Rng1(i, j).Borders(k).ColorIndex = Rng(i, j).Borders(k).ColorIndex
  11.        Rng1(i, j).Borders(k).LineStyle = Rng(i, j).Borders(k).LineStyle
  12.      Next
  13.    Next
  14. Next
  15. End Sub
複製代碼
學海無涯_不恥下問

TOP

swatt

帖子
37 
主題
11 
精華
0 
積分
87 
點名
0  
作業系統
window7 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2011-3-14 
最後登錄
2022-5-30 
3#
發表於 2012-8-23 11:31 | 只看該作者
回復 2# Hsieh

感謝超級版主的幫忙...
果然是需要掃描每個cell的框線才有辦法完全複製，雖然需花多一點時間但問題解決了，讚讚讚啦.....
套用時發現一個小問題，如果將weight擺在最後一項(因錄製macro時weight都擺在最後)會多出不必要的線如附圖,
但只要不要擺在最後一項就沒問題，不知為什麼?
如果超級版主有時間的話，再幫忙答覆一下，再次感謝囉~~~

Sub nn()
Dim Rng As Range, Rng1 As Range
Set Rng = Range("C4:D5") '來源範圍
Set Rng1 = Range("A1:B2") '改變範圍
Rng1.ClearFormats
For i = 1 To Rng.Rows.Count
   For j = 1 To Rng.Columns.Count
     For k = 1 To Rng.Borders.Count
       'Rng1(i, j).Borders(k).Weight = Rng(i, j).Borders(k).Weight
       Rng1(i, j).Borders(k).ColorIndex = Rng(i, j).Borders(k).ColorIndex
       Rng1(i, j).Borders(k).LineStyle = Rng(i, j).Borders(k).LineStyle
       Rng1(i, j).Borders(k).Weight = Rng(i, j).Borders(k).Weight
     Next
   Next
Next
End Sub

   

TOP

        靜思自在 : 待人退一步，愛人寬一寸，就會活得很快樂。
返回列表 上一主題