標題: 關於跨欄置中和框線畫線是否有比較簡易的寫法(謝謝各位大大，已解決。) [打印本頁]

---

作者: av8d    時間: 2012-4-24 09:08     標題: 關於跨欄置中和框線畫線是否有比較簡易的寫法(謝謝各位大大，已解決。)

本帖最後由 av8d 於 2012-4-27 08:12 編輯

首先A1:H1和A2:H2欄取消跨欄置中

1.     Range("A1:G1").Select
   
2.     With Selection
   
3.         .HorizontalAlignment = xlCenter
   
4.         .VerticalAlignment = xlCenter
   
5.         .WrapText = False
   
6.         .Orientation = 0
   
7.         .AddIndent = False
   
8.         .IndentLevel = 0
   
9.         .ShrinkToFit = False
   
10.         .ReadingOrder = xlContext
    
11.         .MergeCells = False
    
12.     End With
    
13.     Selection.Merge
    
14.     Range("A2:G2").Select
    
15.     With Selection
    
16.         .HorizontalAlignment = xlCenter
    
17.         .VerticalAlignment = xlCenter
    
18.         .WrapText = False
    
19.         .Orientation = 0
    
20.         .AddIndent = False
    
21.         .IndentLevel = 0
    
22.         .ShrinkToFit = False
    
23.         .ReadingOrder = xlContext
    
24.         .MergeCells = False
    
25.     End With
    
26.     Selection.Merge
    
27. End Sub

複製代碼

然後是A1:G1和A2:G2跨欄置中

1.     Range("A1:H1").Select
   
2.     With Selection
   
3.         .HorizontalAlignment = xlGeneral
   
4.         .VerticalAlignment = xlCenter
   
5.         .WrapText = False
   
6.         .Orientation = 0
   
7.         .AddIndent = False
   
8.         .IndentLevel = 0
   
9.         .ShrinkToFit = False
   
10.         .ReadingOrder = xlContext
    
11.         .MergeCells = True
    
12.     End With
    
13.     Selection.UnMerge
    
14.     Range("A2:H2").Select
    
15.     With Selection
    
16.         .HorizontalAlignment = xlGeneral
    
17.         .VerticalAlignment = xlCenter
    
18.         .WrapText = False
    
19.         .Orientation = 0
    
20.         .AddIndent = False
    
21.         .IndentLevel = 0
    
22.         .ShrinkToFit = False
    
23.         .ReadingOrder = xlContext
    
24.         .MergeCells = True
    
25.     End With
    
26.     Selection.UnMerge

複製代碼

然後A1:G2框線畫右線

1.     Range("A1:G2").Select
   
2.     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
   
3.     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
   
4.     With Selection.Borders(xlEdgeLeft)
   
5.         .LineStyle = xlContinuous
   
6.         .ColorIndex = 0
   
7.         .TintAndShade = 0
   
8.         .Weight = xlThin
   
9.     End With
   
10.     With Selection.Borders(xlEdgeTop)
    
11.         .LineStyle = xlContinuous
    
12.         .ColorIndex = 0
    
13.         .TintAndShade = 0
    
14.         .Weight = xlThin
    
15.     End With
    
16.     With Selection.Borders(xlEdgeBottom)
    
17.         .LineStyle = xlContinuous
    
18.         .ColorIndex = 0
    
19.         .TintAndShade = 0
    
20.         .Weight = xlThin
    
21.     End With
    
22.     With Selection.Borders(xlEdgeRight)
    
23.         .LineStyle = xlContinuous
    
24.         .ColorIndex = 0
    
25.         .TintAndShade = 0
    
26.         .Weight = xlThin
    
27.     End With
    
28.     Selection.Borders(xlInsideVertical).LineStyle = xlNone
    
29.     With Selection.Borders(xlInsideHorizontal)
    
30.         .LineStyle = xlContinuous
    
31.         .ColorIndex = 0
    
32.         .TintAndShade = 0
    
33.         .Weight = xlThin
    
34.     End With
    
35. End Sub

複製代碼

---

作者: oobird    時間: 2012-4-24 10:56

對於錄製的代碼，你應該把滑鼠放在每一行上按F1，查看它是做什麼用的
然後你就知道哪些語句是用不到的了。
拿來用的代碼對學習無多大幫助。

---

作者: register313    時間: 2012-4-24 12:57

回復 1# av8d

1. Sub aa()
   
2. [A1:G1].Merge
   
3. [A1:G1].HorizontalAlignment = xlCenter
   
4. [A2:G2].Merge
   
5. [A2:G2].HorizontalAlignment = xlCenter
   
6. End Sub
   
7. Sub bb()
   
8. [A1:G1].UnMerge
   
9. [A2:G2].UnMerge
   
10. End Sub
    
11. Sub cc()
    
12. [A1:G2].Borders.LineStyle = xlContinuous
    
13. End Sub

複製代碼

---

作者: GBKEE    時間: 2012-4-24 13:13

回復 1# av8d

1. Sub Ex()
   
2.     Dim xi As Integer
   
3.     For xi = 2 To 10 Step 2
   
4.         With Range("A1:C1,E1:G1").Offset(xi)
   
5.             .Merge
   
6.             .HorizontalAlignment = xlCenter
   
7.             .Borders.LineStyle = xlContinuous
   
8.         End With
   
9.     Next
   
10. End Sub

複製代碼

---

作者: alexliou    時間: 2012-4-24 19:05

本帖最後由 alexliou 於 2012-4-24 19:09 編輯

在一張工作表裡
可能有好幾個地方要畫粗外框線和跨欄置中

我現在都將畫框線和跨欄置中寫成 函式
引數是 Range 物件
每次要畫框線或跨欄置中時
就去呼叫函式   ex.    Call 畫粗外框(Range("A1:A10"))
省得重複一堆 Code

---

作者: GBKEE    時間: 2012-4-24 20:32

回復 5# alexliou
可以貼上程式碼 分享嗎?

---

作者: alexliou    時間: 2012-4-24 21:21

回復 6# GBKEE
這只是把畫粗外框的code集合在一起而已

Sub 畫粗外框(oRrange As Range)
    oRange.Borders(xlDiagonalDown).LineStyle = xlNone
    oRange.Borders(xlDiagonalUp).LineStyle = xlNone
    With oRange.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlMedium
    End With
    With oRange.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlMedium
    End With
    With  oRange.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlMedium
    End With
    With  oRange.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .Weight = xlMedium
    End With
     oRange.Borders(xlInsideVertical).LineStyle = xlNone
     oRange.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

如要更彈性一點, 可將框線的粗細,顏色都設成引數

---

作者: GBKEE    時間: 2012-4-25 07:09

回復 7# alexliou
簡化一下

1. Option Explicit
   
2. Sub 畫粗外框(oRange As Range)
   
3.     Dim xi As Integer
   
4.     With oRange
   
5.         .Borders(5).LineStyle = xlNone      '右斜線
   
6.         .Borders(6).LineStyle = xlNone      '左斜線
   
7.         For xi = 7 To 10                    '外框: 左>上>下>右
   
8.             With .Borders(xi)
   
9.                 .LineStyle = xlContinuous
   
10.                 .ColorIndex = 3
    
11.                 .Weight = xlMedium
    
12.             End With
    
13.         Next
    
14.         If .Columns.Count > 1 Then          '直線  需兩欄以上
    
15.             With .Borders(11)
    
16.                 .LineStyle = 1  '
    
17.                 .ColorIndex = 3
    
18.             End With
    
19.         End If
    
20.         If .Rows.Count > 1 Then             '橫線   需兩列以上
    
21.             With .Borders(12)
    
22.                 .LineStyle = 1
    
23.                 .ColorIndex = 3
    
24.             End With
    
25.         End If
    
26.      End With
    
27. End Sub

複製代碼

---

作者: oobird    時間: 2012-4-25 08:01

本帖最後由 oobird 於 2012-4-25 08:02 編輯

1. Sub yy()
   
2.     With Selection
   
3.         .Borders.LineStyle = 0
   
4.         .Borders.LineStyle = 1
   
5.         .Borders.ColorIndex = 5
   
6.         .BorderAround , 3, 5
   
7.     End With
   
8. End Sub

複製代碼

可選取一個範圍，或同時選多個區域，一起給框線。內框為1，外框為3，5是顏色

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)