VBA常用技巧代码解析

yuanzhuping

技巧9         单元格自动进入编辑状态
       当光标选择单元格时无需双击，自动进入编辑状态，如下面的代码所示。

1. #001  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. #002      If Target.Column = 3 And Target.Count = 1 Then
   
3. #003          If Target <> "" Then
   
4. #004              Application.SendKeys "{F2}"
   
5. #005          End If
   
6. #006      End If
   
7. #007  End Sub

复制代码

代码解析：
       工作表的SelectionChange事件过程，当选择工作表C列有数据单元格时自动进入编辑状态。
       第2、3行代码设置SelectionChange事件的触发条件，利用Target参数的Column属性和Count属性将事件的触发条件限制在C列并且只有在选择一个单元格时才发生。
       第4行代码使用SendKeys方法发送一个F2键到应用程序，等同于选择单元格后按F2键，使单元格进入编辑状态。

[ 本帖最后由 yuanzhuping 于 2009-2-16 22:12 编辑 ]

yuanzhuping

技巧10         禁用单元格拖放功能
       在工作表中可以拖放单元格右下角的小十字对单元格内容进行复制等操作，如果不希望用户进行此操作可以禁用单元格拖放功能，如下面的代码所示。

1. #001  Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. #002      If Not Application.Intersect(Target, Range("A1:A15")) Is Nothing Then
   
3. #003          Application.CellDragAndDrop = False
   
4. #004      Else
   
5. #005          Application.CellDragAndDrop = True
   
6. #006      End If
   
7. #007  End Sub

复制代码

代码解析：
       工作表的SelectionChange事件过程，在指定的单元格区域禁用单元格的拖放功能。
       CellDragAndDrop 属性设置单元格的拖放功能，如果允许使用单元格拖放功能，则该值为True。
       为了不影响其他工作表，应在工作表的Deactivate事件中恢复单元格的拖放功能，如下面的代码所示。

1. #001  Private Sub Worksheet_Deactivate()
   
2. #002      Application.CellDragAndDrop = True
   
3. #003  End Sub

复制代码

代码解析：
       工作表的Deactivate事件过程，恢复单元格的拖放功能。
       工作表的Deactivate事件当工作表从活动状态转为非活动状态时产生，语法如下：
Private Sub object_Deactivate()
       参数object代表Worksheet对象。
       当选择工作表“Sheet1”的A1：A15单元格时将禁用单元格的拖放功能，如图所示。


[ 本帖最后由 yuanzhuping 于 2009-2-16 23:01 编辑 ]

jury2003

先学习一下!!!收起来

leitiger

搬个凳子坐着看。版主辛苦了。

yuanzhuping

技巧11         单元格格式操作
11-1        单元格字体格式设置
       在VBA中可以对单元格的字体格式进行各种设置，如下面的代码所示。

1. #001  Public Sub RngFont()
   
2. #002      With Range("A1").Font
   
3. #003          .Name = "华文彩云"
   
4. #004          .FontStyle = "Bold"
   
5. #005          .Size = 18
   
6. #006          .ColorIndex = 3
   
7. #007          .Underline = 2
   
8. #008      End With
   
9. #009  End Sub

复制代码

代码解析：
       RngFont过程对单元格A1的字体格式进行设置。
       其中第3行代码设置字体为“华文彩云”，应用于Font对象的Name属性返回或设置对象的名称。
       第4行代码设置字体为加粗，FontStyle属性返回或设置字体样式。设置为“Bold” 加粗字体，设置为“Italic”倾斜字体，也可以设置成“Bold Italic”。
       第5行代码设置字体的大小为18磅，Size属性返回或设置字体大小。
       第6行代码设置字体的颜色为红色，应用于Font对象的ColorIndex属性返回或设置字体的颜色，该颜色可指定为当前调色板中颜色的编号，如图所示。

       第7行代码设置字体为单下划线类型，Underline属性返回或设置应用于字体的下划线类型，可为表格所列的XlUnderlineStyle常量之一。

       运行RngFont过程结果如图所示。


[ 本帖最后由 yuanzhuping 于 2009-2-16 22:13 编辑 ]

yuanzhuping

技巧11         单元格格式操作
11-2        设置单元格内部格式
       设置单元格的Interior属性可以对单元格的内部格式进行设置，如下面的代码所示。

1. #001  Sub RngInterior()
   
2. #002      With Range("A1").Interior
   
3. #003          .ColorIndex = 3
   
4. #004          .Pattern = xlPatternCrissCross
   
5. #005          .PatternColorIndex = 6
   
6. #006      End With
   
7. #007  End Sub

复制代码

代码解析：
       RngInterior过程对A1单元格的内部格式进行设置。
       第2行代码使用Interior属性返回单元格对象的内部。
       第3行代码设置单元格边框内部的颜色为红色。应用于Interior对象的ColorIndex属性返回或设置边框内部的颜色，可指定为如技巧11-1所示的当前调色板中颜色的编号或为XlColorIndex 常量之一：xlColorIndexAutomatic （自动填充）、xlColorIndexNone （无内部填充）。
       第4行代码设置单元格设置内部图案为十字图案。应用于Interior对象的Pattern属性返回或者设置内部图案。
       第5行代码设置单元格设置内部图案的颜色为黄色。应用于Interior对象的PatternColorIndex属性返回或设置内部图案的颜色，可指定为如技巧11-1中所示的当前调色板中颜色的编号或为XlColorIndex常量之一：xlColorIndexAutomatic （自动填充）、xlColorIndexNone （无内部填充）。
运行RngInterior过程结果如图所示。


[ 本帖最后由 yuanzhuping 于 2009-2-16 22:14 编辑 ]

upbachelor

Thank you very much!

yuanzhuping

技巧11         单元格格式操作
11-3        为单元格区域添加边框
       我们为单元格区域添加边框时往往通过录制宏获取代码，但宏录制器生成的代码分别设置单元格区域的每个边框，因此代码多且效率低。使用Range对象的Borders集合可以快速的对单元格区域的每个边框应用相同的格式，而Range对象的BorderAround方法则可以快速地为单元格区域添加一个外边框，如下面的代码所示。

1. #001  Sub AddBorders()
   
2. #002       Dim rng As Range
   
3. #003       Set rng = Range("B4:G10")
   
4. #004       With rng.Borders
   
5. #005           .LineStyle = xlContinuous
   
6. #006           .Weight = xlThin
   
7. #007           .ColorIndex = 5
   
8. #008       End With
   
9. #009       rng.BorderAround xlContinuous, xlMedium, 5
   
10. #010       Set rng = Nothing
    
11. #011  End Sub

复制代码

代码解析：
       AddBorders过程为单元格区域B4:G10设置内部统一边框并添加一个加粗外边框。
       第4行到第8行代码使用Borders属性引用单元格区域的Borders集合，其中第5行代码设置其边框样式线条的样式，第6行代码设置边框线条的粗细，第7行代码设置边框的颜色。
       应用于Range对象的Borders集合代表Range对象的4个边框（左边框、右边框、顶部边框和底部边框）的4个Border对象组成的集合，这4个边框既可单独返回，也可作为一个组同时返回。
       第9行代码使用BorderAround方法为单元格区域添加一个加粗外边框。
       应用于Range对象的BorderAround方法向单元格区域添加整个区域的外边框，并设置该边框的相关属性，其语法如下：
BorderAround(LineStyle, Weight, ColorIndex, Color)
       其中LineStyle参数设置边框线条的样式，Weight参数设置边框线条的粗细，ColorIndex参数设置边框颜色，Color参数以RGB值指定边框的颜色。
       注意 指定Color参数可以设置颜色为当前调色板之处的其它颜色，不能同时指定ColorIndex参数和Color参数。
       运行AddBorders过程，效果如图所示。

       如果需要在单元格区域中应用多种边框格式，则需分别设置各边框格式，如下面的代码所示。

1. #001  Sub BordersDemo()
   
2. #002       Dim rng As Range
   
3. #003       Set rng = Sheet2.Range("B4:G10")
   
4. #004       With rng.Borders(xlInsideHorizontal)
   
5. #005           .LineStyle = xlDot
   
6. #006           .Weight = xlThin
   
7. #007           .ColorIndex = 5
   
8. #008       End With
   
9. #009       With rng.Borders(xlInsideVertical)
   
10. #010           .LineStyle = xlContinuous
    
11. #011           .Weight = xlThin
    
12. #012           .ColorIndex = 5
    
13. #013       End With
    
14. #014       rng.BorderAround xlContinuous, xlMedium, 5
    
15. #015       Set rng = Nothing
    
16. #016  End Sub

复制代码

代码解析：
       BordersDemo过程代码为单元格区域内部边框在水平和垂直方向上应用不同格式，并为区域添加一个加粗外边框。
       Borders(index)属性返回单个Border对象，其Index参数取值可为表格所列的XlBordersIndex常量之一：

       运行BordersDemo过程效果如图所示。


[ 本帖最后由 yuanzhuping 于 2009-2-16 22:16 编辑 ]

yuanzhuping

技巧11         单元格格式操作
11-4        灵活设置单元格的行高列宽
       一般情况下单元格的行高列宽都是以磅为单位进行设置的，也可以使用英寸和厘米计量单位设置单元格的行高列宽，如下面的代码所示。

1. #001  Sub RngToPoints()
   
2. #002      With Range("A1")
   
3. #003          .RowHeight = Application.CentimetersToPoints(2)
   
4. #004          .ColumnWidth = Application.CentimetersToPoints(1.5)
   
5. #005      End With
   
6. #006      With Range("A2")
   
7. #007          .RowHeight = Application.InchesToPoints(1.2)
   
8. #008          .ColumnWidth = Application.InchesToPoints(0.3)
   
9. #009      End With
   
10. #010  End Sub

复制代码

代码解析：
       RngToPoints过程以英寸和厘米计量单位设置单元格的行高列宽。
       第3、4行代码使用CentimetersToPoints方法以厘米为计量单位设置A1单元格的行高列宽。CentimetersToPoints方法将计量单位从厘米转换为磅（一磅等于 0.035 厘米），语法如下：
expression.CentimetersToPoints(Centimeters)
参数expression是必需的，返回一个Application对象。
       参数Centimeters是必需的，指定要转换为磅值的厘米值。
       第5、6行代码使用InchesToPoints方法以英寸为计量单位设置B2单元格的行高列宽。InchesToPoints方法将计量单位从英寸转换为磅，语法如下：
expression.InchesToPoints(Inches)
       参数expression是必需的，返回一个Application对象。
       参数Inches是必需的，指定要转换为磅值的英寸值。
       运行RngToPoints过程结果如图所示。


[ 本帖最后由 yuanzhuping 于 2009-2-16 22:17 编辑 ]

willin2000

太谢谢yuanzhuping版主了!

力顶!!!