D.实现自动化功能,用到了一些VBA

2020-03-20 作者:首页   |   浏览(81)

我用的是VB6.0,我学着做了一段封装VBA的代码,在试运行的时候正常,但在生成工程文件的时候报错:“编译错误,用户类型定义未定义。” 请高手点一下。先谢过了。

VB中Excel 2010的导入导出操作

 

编写人:左丘文

 

2015-4-11

近来这已是第二篇在讨论VB的相关问题,今天在这里,我想与大家一起分享一下在VB中如何从Excel中导入数据和导出数据到Excel(程序支持excel2010),在此做个小结,以供参考。有兴趣的同学,可以一同探讨与学习一下,否则就略过吧。

 

1、 程序导入导出操作介面:

图片 1 

2、 从excel导入数据代码:

图片 2图片 3

  1 Private Sub cmdinput_Click()
  2    
  3    'Modify By KevinZhang 2014-8-21
  4     Dim sFile As String
  5     Dim btrans As Boolean
  6     sFile = txtFILE.Text
  7     If Not FileExists(sFile) Then
  8         MsgBox "指定的导入文件不存在,请重新选择!", vbOKOnly + vbExclamation
  9         Exit Sub
 10     End If
 11       '连接excel
 12     Dim conn
 13     Set conn = CreateObject("ADODB.Connection")
 14     'connExcelStr = "Provider = Microsoft.Jet.OLEDB.4.0 ; Data Source =" & sFile & ";Extended Properties='Excel 8.0;HDR=YES'"
 15     'connExcelStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & sFile & ";Extended Properties='Excel 12.0 Xml;HDR=YES;'"
 16     'connExcelStr = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source =" & sFile & ";Extended Properties='Excel 8.0;HDR=YES;IMEX=1'"
 17      connExcelStr = "Provider=Microsoft.ACE.OLEDB.12.0; Persist Security Info=False;Data Source=" & sFile & "; Extended Properties='Excel 8.0;HDR=Yes;IMEX=2'"
 18     On Error GoTo checkgetexcel
 19       conn.Open connExcelStr
 20    Dim rs As ADODB.Recordset
 21     Set rs = New ADODB.Recordset
 22     With rs
 23         .ActiveConnection = conn
 24         .LockType = adLockReadOnly
 25         .CursorLocation = adUseClient
 26         .CursorType = adOpenKeyset
 27         .Open "select * from [Sheet1$]"
 28     End With
 29    
 30  
 31    Dim rs2 As ADODB.Recordset
 32    Set rs2 = New ADODB.Recordset
 33    Dim i As Integer
 34  If (rs.RecordCount >= 1) Then
 35  i = rs.RecordCount
 36  
 37  '*****************************************************************************
 38  '同时生成一个错误清单
 39  
 40    '定义变量
 41   Dim j, k, o, z As Long
 42  
 43     '初始化循环的变量数值
 44     j = 2
 45     '初始化Excel组建
 46 Set xlApp = CreateObject("Excel.Application")
 47  Set xlBook = xlApp.Workbooks.Add
 48  Set xlsheet = xlBook.WorkSheets("Sheet1")
 49  
 50 '打开选定的文件
 51 'Set xlBook = xlApp.Workbooks.Open(sFile)
 52 '设置其可见
 53 'xlApp.Visible = True
 54 '设置其工作表的名称
 55 Set xlsheet = xlBook.WorkSheets("Sheet1") '设置活动工作表
 56 '执行SQL连接方法,查询语句,和返回的文本
 57  
 58 '循环,到数据库的总行
 59  xlsheet.Cells(1, 1) = "料号" '给单元格(row,col)赋值
 60  xlsheet.Cells(1, 2) = "单价" '给单元格(row,col)赋值
 61   xlsheet.Cells(1, 3) = "错误信息" '给单元格(row,col)赋值
 62  
 63  '***********************************************************************
 64 Call ShowInforDlg("正在导入数据,请稍候...")
 65 ConGamma.beginTrans
 66 btrans = True
 67 rs.MoveFirst
 68 Do While Not rs.EOF
 69    Set rs2 = ExecSQL("Insert_PackMat_Auto  '" & txtYEAR.Text & " ','" & txtIQUARTER.Text & "' ,'" _
 70                    & rs!PRONUM & "','" & rs!price & "'", ConGamma)
 71  
 72  
 73 If rs2.RecordCount = 1 Then
 74  
 75  If rs2.Fields(0).Value = "存在相同物料成本记录" Then
 76   'MsgBox "导入失败,请先删除该料号:" & rs!PRONUM & "再导入!!", vbCritical
 77  
 78 '*************************************************************************************************
 79 '初始化列
 80    o = 0
 81     For k = 1 To rs.Fields.count
 82       '给Excel列赋值
 83       xlsheet.Cells(j, k) = rs.Fields(o).Value '给单元格(row,col)赋值
 84       '列往后进一位
 85      o = o + 1
 86    
 87     Next
 88     xlsheet.Cells(j, rs.Fields.count + 1) = "存在相同物料成本记录" '给单元格(row,col)赋值
 89       '行往后一步
 90      j = j + 1
 91   '*******************************************************************************************
 92   i = i - 1
 93  End If
 94 Else
 95     'MsgBox "导入失败,请先检查该料号:" & rs!PRONUM, , vbCritical
 96     '*************************************************************************************************
 97 '初始化列
 98    o = 0
 99     For k = 1 To rs.Fields.count
100       '给Excel列赋值
101       xlsheet.Cells(j, k) = rs.Fields(o).Value '给单元格(row,col)赋值
102       '列往后进一位
103      o = o + 1
104    
105     Next
106     xlsheet.Cells(j, rs.Fields.count + 1) = "请先检查该料号" '给单元格(row,col)赋值
107       '行往后一步
108      j = j + 1
109   '*******************************************************************************************
110    
111     i = i - 1
112    
113    
114 End If
115  
116    rs.MoveNext
117 Loop
118 ConGamma.CommitTrans
119 rs.MoveFirst
120 btrans = False
121 Call UnloadInforDlg
122   If rs.RecordCount > 0 Then
123          MsgBox "共有" & i & "条记录被导入,错误信息请阅导入文件目录的Error.xls文件", vbInformation
124     End If
125   End If
126   '**********************************************
127      'xlsheet.PrintOut '打印工作表
128      Dim ssfile() As String
129      Dim ssfile2 As String
130      ssfile = Split(sFile, "")
131      For i = 0 To UBound(ssfile) - 1
132      ssfile2 = ssfile2 & ssfile(i) & ""
133      Next
134      ssfile2 = ssfile2 & "Error.xls"
135     xlBook.SaveAs (ssfile2)
136     xlBook.Close (True) '关闭工作簿
137     xlApp.Quit '结束EXCEL对象
138     Set xlApp = Nothing '释放xlApp对象
139  '******************************************************
140    rs.Close
141   Set rs = Nothing
142    If Trim(txtYEAR.Text) <> "" Then
143         Call frmMDI.ITMDIAdminX.ControlSearch
144          Exit Sub
145     End If
146    
147 checkgetexcel:
148     MsgBox "请检查excel是否存在,excel中是否有Sheet1的工作表。(系统默认读取excel的Sheet1的工作表)", vbInformation
149   If ERR.Number <> 0 Then
150     MsgBox ERR.Description
151   End If
152  
153    Exit Sub
154 End Sub

View Code

 

3、 导出到excel代码

图片 4图片 5

 1 Private Sub cmdExport_Click()
 2 'Modify By KevinZhang 2014-8-22
 3     '定义变量
 4   Dim i, j, k, o, z As Long
 5  
 6   Dim rs As ADODB.Recordset
 7    Dim sFile As String
 8   '初始化文件打开窗口
 9    If txtFILE.Text <> "" Then
10        sFile = RTrim(txtFILE.Text)
11     Else '如果等于空,则关闭方法
12       MsgBox "请选择要导出的文件名", vbCritical
13       Exit Sub
14     End If
15    
16     If FileExists(sFile) Then
17         If MsgBox("存在相同的档案名称,要替代吗?", vbQuestion + vbYesNoCancel) <> vbYes Then Exit Sub
18     End If
19    
20    Screen.MousePointer = vbHourglass
21  
22    On Error GoTo Err_Proc
23  
24     '初始化循环的变量数值
25     i = 2
26     j = 1
27     '初始化Excel组建
28 Set xlApp = CreateObject("Excel.Application")
29  Set xlBook = xlApp.Workbooks.Add
30  Set xlsheet = xlBook.WorkSheets("Sheet1")
31  
32 '打开选定的文件
33 'Set xlBook = xlApp.Workbooks.Open(sFile)
34 '设置其可见
35 'xlApp.Visible = True
36 '设置其工作表的名称
37 Set xlsheet = xlBook.WorkSheets("Sheet1") '设置活动工作表
38 '执行SQL连接方法,查询语句,和返回的文本
39 Set rs = ExecSQL("select * from PACKMATDTL where YEAR= '" & txtYEAR.Text & " '  AND IQUARTER='" & txtIQUARTER.Text & "'", ConGamma)
40 '循环,到数据库的总行
41  
42  
43  xlsheet.Cells(1, 1) = "年份" '给单元格(row,col)赋值
44  xlsheet.Cells(1, 2) = "季度" '给单元格(row,col)赋值
45  xlsheet.Cells(1, 3) = "料号" '给单元格(row,col)赋值
46  xlsheet.Cells(1, 4) = "单价" '给单元格(row,col)赋值
47  
48 For z = 1 To rs.RecordCount
49 '初始化列
50  o = 0
51     For k = 1 To rs.Fields.count
52       '给Excel列赋值
53       xlsheet.Cells(i, k) = rs.Fields(o).Value '给单元格(row,col)赋值
54       '列往后进一位
55      o = o + 1
56    
57     Next
58     '数据库标往后一步
59      rs.MoveNext
60       '行往后一步
61      i = i + 1
62      j = j + 1
63  Next
64     'xlsheet.PrintOut '打印工作表
65     xlBook.SaveAs (sFile)
66     xlBook.Close (True) '关闭工作簿
67     xlApp.Quit '结束EXCEL对象
68     Set xlApp = Nothing '释放xlApp对象
69     MsgBox "共有" & rs.RecordCount & "条记录被导出", vbInformation
70   rs.Close
71   Set rs = Nothing
72    Screen.MousePointer = vbDefault
73             Exit Sub
74  
75    
76    
77 Err_Proc:
78           Screen.MousePointer = vbDefault
79           MsgBox "请确认您的电脑已安装Excel!", vbExclamation, "提示"
80  
81    
82    
83 End Sub

View Code

有关更多的技术分享,大家可以加入我们的技术群,进行源码的分享。

 

欢迎加入技术分享群:238916811

 

 

最近单位内部的项目里要用到些报表EXCEL的生成,虽说JAVA 的POI可以有这能力,但觉得还是可能比较麻烦,因此还是转用.net来搞,用visual studio 2003配合office 2003,用到了一些VBA,因此小结并归纳之,选了些资料归纳在这里,以备今后查考

Sub hongtong()  
   Dim excelApp As New Excel.Application
   Dim excelWorkBook As Excel.Workbook
   Dim excelWorksheet As Excel.Worksheet
   Set excelWorkBook = excelApp.Workbooks.Add  '创建新工作簿
   Set excelWorksheet = excelWorkBook.Sheets(1)

什么是VBA?它有什么作用?

首先创建 Excel 对象,使用ComObj:

   excelWorksheet.Cells(2, 3) = "宏通"      '写入数据
   excelWorksheet.Cells(3, 4) = "zyg365"    '写入数据

 A.实现Excel中没有实现的功能。

Dim ExcelID as Excel.Application

   excelApp.Visible = True        '显示excel界面,用于调试
   excelWorkBook.PrintPreview     '打印预览
   excelWorkBook.PrintOut         '打印输出
   excelWorkBook.Saved = True
   'excelWorkBook.Close           '关闭工作薄
   'excelApp.Quit                 '退出excel
End Sub

 B.提高运行速度。

Set ExcelID as new Excel.Application

图片 6

 C.编写自定义函数。

1) 显示当前窗口:

 D.实现自动化功能。

ExcelID.Visible := True;

 E.通过插入窗体做小型管理软件。

2) 更改 Excel 标题栏:

VBA在哪里存放的?怎么运行?

ExcelID.Caption := '应用程序调用 Microsoft Excel';

 A.模块中

3) 添加新工作簿:

   在Excel 2010中若没有“开发工具”项,通过“文件”——“选项”——“自定义功能区”——选中“开发工具”——“确定”(图1)。

        ExcelID.WorkBooks.Add;

(注:为了提高word2010中插入的图片的质量,“文件”——“选项”——“高级”——选中“不压缩文件图像质量”——“确定”。)

4) 打开已存在的工作簿:

 

        ExcelID.WorkBooks.Open( 'C:ExcelDemo.xls' );

图1 选中“文件”—“选项”

5) 设置第2个工作表为活动工作表:

图2 ”自定义功能区”—“开发工具”——“确定”

        ExcelID.WorkSheets[2].Activate; 

 

 或 ExcelID.WorkSheets[ 'Sheet2' ].Activate;

图3 最终的界面多出了“开发工具”选项卡

6) 给单元格赋值:

 

        ExcelID.Cells[1,4].Value := '第一行第四列';

                                                               图4 代码存放在“模块”中

7) 设置指定列的宽度(单位:字符个数),以第一列为例:

B.运行宏

        ExcelID.ActiveSheet.Columns[1].ColumnsWidth := 5;

单击向右的绿三角,即可以运行。

8) 设置指定行的高度(单位:磅)(1磅=0.035厘米),以第二行为例:

 

        ExcelID.ActiveSheet.Rows[2].RowHeight := 1/0.035; // 1厘米

   

9) 在第8行之前插入分页符:

                                                   图5 右绿三角运行  

        ExcelID.WorkSheets[1].Rows[8].PageBreak := 1;

                                                          图6  选中test并“运行”

10) 在第8列之前删除分页符:

 

        ExcelID.ActiveSheet.Columns[4].PageBreak := 0;

                                                    图7 运行结果

11) 指定边框线宽度:

3.什么是宏?宏和VBA有什么关系?

        ExcelID.ActiveSheet.Range[ 'B3:D4' ].Borders[2].Weight := 3;

 宏(Macro),是一种批量处理。

           1-左    2-右   3-顶    4-底   5-斜( )     6-斜( / )

 宏通常既可以录制又可以手动编程,而VBA一般是通过编程完成。宏可以和VBA相结合使用。

12) 清除第一行第四列单元格公式:

4.录制一个宏。

        ExcelID.ActiveSheet.Cells[1,4].ClearContents;

  A.“开发工具”——“录制宏”——宏名为“输入100”——“录制”——在A1单元格中输入100——“停止”。

13) 设置第一行字体属性:

  B.“宏”——选中“输入100”——“执行”。

ExcelID.ActiveSheet.Rows[1].Font.Name := '隶书';

  

ExcelID.ActiveSheet.Rows[1].Font.Color := clBlue;

5.编写一个宏。

ExcelID.ActiveSheet.Rows[1].Font.Bold   := True;

  A.“开发工具”——“Visual Basic”——“视图”——“工程资源管理器”——“插入”——“模块”——在右侧输入代码:

ExcelID.ActiveSheet.Rows[1].Font.UnderLine := True;

   图片 7

14) 进行页面设置:

  B. 单击绿右三角即可运行。或者关闭VBA编辑窗口,单击“宏”——选中“test”——“执行”。

 a.页眉:

 

           ExcelID.ActiveSheet.PageSetup.CenterHeader := '报表演示';

6.VBA语句

 b.页脚:

  A.宏程序语句。

           ExcelID.ActiveSheet.PageSetup.CenterFooter := '第&P页';

   图片 8

 c.页眉到顶端边距2cm:

  B.函数程序语句

           ExcelID.ActiveSheet.PageSetup.HeaderMargin := 2/0.035;

  图片 9

 d.页脚到底端边距3cm:

 C.在程序中应运语句。

           ExcelID.ActiveSheet.PageSetup.HeaderMargin := 3/0.035;

  图片 10

 e.顶边距2cm:

D.循环语句。

           ExcelID.ActiveSheet.PageSetup.TopMargin := 2/0.035;

  图片 11

 f.底边距2cm:

7.VBA对象

           ExcelID.ActiveSheet.PageSetup.BottomMargin := 2/0.035;

  A.工作簿对象

 g.左边距2cm:

     Workbooks 代表工作簿集合,所有的工作簿,Workbooks(N),表示已打开的第N个工作簿

           ExcelID.ActiveSheet.PageSetup.LeftMargin := 2/0.035;

     Workbooks ("工作簿名称")

 h.右边距2cm:

     ActiveWorkbook 正在操作的工作簿

           ExcelID.ActiveSheet.PageSetup.RightMargin := 2/0.035;

     ThisWorkBook '代码所在的工作簿

 i.页面水平居中:

  B.工作表对象

           ExcelID.ActiveSheet.PageSetup.CenterHorizontally := 2/0.035;

     Sheets("工作表名称")

 j.页面垂直居中:

     Sheet1 表示第一个插入的工作表,Sheet2表示第二个插入的工作表....

           ExcelID.ActiveSheet.PageSetup.CenterVertically := 2/0.035;

     Sheets(n) 表示按排列顺序,第n个工作表

 k.打印单元格网线:

     ActiveSheet 表示活动工作表,光标所在工作表

           ExcelID.ActiveSheet.PageSetup.PrintGridLines := True;

     worksheet 也表示工作表,但不包括图表工作表、宏工作表等。

15) 拷贝操作:

  C.单元格对象

 a.拷贝整个工作表:

     cells 所有单元格

           ExcelID.ActiveSheet.Used.Range.Copy;

     Range ("单元格地址")

  b.拷贝指定区域:

     Cells(行数,列数)    Range(“B3”)和Cells(3,2)表示相同的单元格

           ExcelID.ActiveSheet.Range[ 'A1:E2' ].Copy;

     Activecell 正在选中或编辑的单元格

 c.从A1位置开始粘贴:

     Selection 正被选中或选取的单元格或单元格区域

           ExcelID.ActiveSheet.Range.[ 'A1' ].PasteSpecial;

8. VBA属性

 d.从文件尾部开始粘贴:

    VBA属性就是VBA对象所具有的特点,表示某个对象的属性如下:对象.属性=属性值

           ExcelID.ActiveSheet.Range.PasteSpecial;

    Sub ttt()

16) 插入一行或一列:

      Range("a1").Value = 100     ’给单元格a1填充数值100

   a. ExcelID.ActiveSheet.Rows[2].Insert;

    End Sub

   b. ExcelID.ActiveSheet.Columns[1].Insert;

                                                                                                                                    

17) 删除一行或一列:

    Sub ttt1()

    a. ExcelID.ActiveSheet.Rows[2].Delete;

      Sheets(1).Name = "工作表改名了"   ’给工作簿重命名为“工作表改名了”

    b. ExcelID.ActiveSheet.Columns[1].Delete;

    End Sub

18) 打印预览工作表:

                                                                                                                                       

        ExcelID.ActiveSheet.PrintPreview;

    Sub ttt2()

19) 打印输出工作表:

       Sheets("Sheet2").Range("a1").Value = "abcd"   ’给sheet2工作表的a1单元格填充字符串“abcd”

        ExcelID.ActiveSheet.PrintOut;

    End Sub

20) 工作表保存:

                                                                                                                                        

      If not ExcelID.ActiveWorkBook.Saved then

      Sub ttt3()

          ExcelID.ActiveSheet.PrintPreview

     ’单元格的内部的填充色

   End if

          Range("A2").Interior.ColorIndex = 3  ’将A2单元格的背景颜色设置为红色

21) 工作表另存为:

         Range("A2").Font.ColorIndex = 3      ’将A2单元格的字体颜色设置为红色

        ExcelID.SaveAs( 'C:ExcelDemo1.xls' );

      End Sub

22) 放弃存盘:

                                                                                                                                           

        ExcelID.ActiveWorkBook.Saved := True;

9.VBA方法

23) 关闭工作簿:

   VBA方法是作用于VBA对象上的动作,表示用某个方法作用于VBA的对象上,可以用下面的格式:

        ExcelID.WorkBooks.Close;

   对象.方法  参数名称:=参数值

24) 退出 Excel:

                                                                                                                                            

ExcelID.Quit;

  Sub ttt4()

25) 设置工作表密码:

      ’Range("A1").Copy Destination:= Range("A2")

ExcelID.ActiveSheet.Protect "123", DrawingObjects:=True, Contents:=True, Scenarios:=True

      Range("A1").Copy Range("A2")   ’将A1中的内容复制到A2

26) EXCEL的显示方式为最大化

  End Sub

ExcelID.Application.WindowState = xlMaximized   

                                                                                                                                            

27) 工作薄显示方式为最大化

  Sub ttt5()

ExcelID.ActiveWindow.WindowState = xlMaximized 

    Sheet1.Move before:=Sheets("Sheet3")   ’将sheet1表移动到sheet3之前

28) 设置打开默认工作薄数量

  End Sub

ExcelID.SheetsInNewWorkbook = 3

                                                                                                                                           

29) '关闭时是否提示保存(true 保存;false 不保存)

10.在一个乡政府的文件中要求将Excel中一个表格的身份证号,配对并填充到另一个表中。宏代码如下:

ExcelID.DisplayAlerts = False 

     Sub 配对()

30) 设置拆分窗口,及固定行位置

      Dim I, J As Integer

ExcelID.ActiveWindow.SplitRow = 1

      For I = 3 To 225

ExcelID.ActiveWindow.FreezePanes = True

           For J = 4 To 930

31) 设置打印时固定打印内容

               If Sheets("Sheet4").Range("b" & I).Value = Sheets("黄门乡").Range("b" & J).Value Then   

ExcelID.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1" 

                     Sheets("Sheet4").Range("e" & I).Value = Sheets("黄门乡").Range("d" & J).Value

32) 设置打印标题

              End If

ExcelID.ActiveSheet.PageSetup.PrintTitleColumns = ""  

         Next J

33) 设置显示方式(分页方式显示)

       Next I

ExcelID.ActiveWindow.View = xlPageBreakPreview 

     End Sub

34) 设置显示比例

     ’竟然没写入End IF,提示错误“Next 缺少 For”

ExcelID.ActiveWindow.Zoom = 100                 

11.判断语句

35) 让Excel 响应 DDE 请求

   A.if判断语句

Ex.Application.IgnoreRemoteRequests = False

                                                                                                                           

 

     Sub 判断1() '单条件判断

用VB操作EXCEL

       If Range("a1").Value > 0 Then

Private Sub Command3_Click()

            Range("b1") = "正数"

On Error GoTo err1

       Else

    Dim i As Long

            Range("b1") = "负数或0"

    Dim j As Long

       End If

    Dim objExl As Excel.Application   '声明对象变量

     End Sub

    Me.MousePointer = 11            '改变鼠标样式

  B.IIF判断语句

    Set objExl = New Excel.Application '初始化对象变量

                                                                                                                            

    objExl.SheetsInNewWorkbook = 1 '将新建的工作薄数量设为1

    Sub 判断4()

    objExl.Workbooks.Add          '增加一个工作薄

        Range("a3") = IIf(Range("a1") <= 0, "负数或零", "负数")

    objExl.Sheets(objExl.Sheets.Count).Name = "book1" '修改工作薄名称

    End Sub

    objExl.Sheets.Add , objExl.Sheets("book1") ‘增加第二个工作薄在第一个之后

  C.select判断

    objExl.Sheets(objExl.Sheets.Count).Name = "book2"

                                                                                                                             

   objExl.Sheets.Add , objExl.Sheets("book2") ‘增加第三个工作薄在第二个之后

    Sub 判断1() '单条件判断

objExl.Sheets(objExl.Sheets.Count).Name = "book3"

      Select Case Range("a1").Value

 

      Case Is > 0

objExl.Sheets("book1").Select     '选中工作薄<book1>

         Range("b1") = "正数"

    For i = 1 To 50                   '循环写入数据

      Case Else

        For j = 1 To 5

         Range("b1") = "负数或0"

If i = 1 Then

      End Select

                        objExl.Selection.NumberFormatLocal = "@" '设置格式为文本

    End Sub

objExl.Cells(i, j) = " E " & i & j

                                                                                                                               

            Else

    Sub 判断2() '多条件判断

               objExl.Cells(i, j) = i & j

        Select Case Range("a1").Value

            End If

         Case Is > 0

        Next

           Range("b1") = "正数"

    Next

         Case Is = 0

 

           Range("b1") = "0"

          objExl.Rows("1:1").Select         '选中第一行

         Case Else

          objExl.Selection.Font.Bold = True   '设为粗体

           Range("b1") = "负数"

          objExl.Selection.Font.Size = 24     '设置字体大小

         End Select

          objExl.Cells.EntireColumn.AutoFit  '自动调整列宽

       End Sub

objExl.ActiveWindow.SplitRow = 1 '拆分第一行

                                                                                                                                                     

          objExl.ActiveWindow. SplitColumn = 0 '拆分列

      Sub 判断3()

objExl.ActiveWindow.FreezePanes = True   '固定拆分          objExl.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1" '设置打印固定行

         If Range("a3") < "G" Then

objExl.ActiveSheet.PageSetup.PrintTitleColumns = ""    '打印标题    objExl.ActiveSheet.PageSetup.RightFooter = "打印时间: " & _

            MsgBox "A-G"

                   Format(Now, "yyyy年mm月dd日 hh:MM:ss")

         End If

          objExl.ActiveWindow.View = xlPageBreakPreview    '设置显示方式

      End Sub

          objExl.ActiveWindow.Zoom = 100                 '设置显示大小

D.区间判断

    '给工作表加密码

                                                                                                                                     

objExl.ActiveSheet.Protect "123", DrawingObjects:=True,  _

  Sub if区间判断()

Contents:=True, Scenarios:=True

  If Range("a2") <= 1000 Then

          objExl.Application.IgnoreRemoteRequests = False

    Range("b2") = 0.01

          objExl.Visible = True                       '使EXCEL可见

  ElseIf Range("a2") <= 3000 Then

          objExl.Application.WindowState = xlMaximized 'EXCEL的显示方式为最大化

    Range("b2") = 0.03

          objExl.ActiveWindow.WindowState = xlMaximized '工作薄显示方式为最大化

  ElseIf Range("a2") > 3000 Then

          objExl.SheetsInNewWorkbook = 3           '将默认新工作薄数量改回3个

    Range("b2") = 0.05

   Set objExl = Nothing    '清除对象

  End If

          Me.MousePointer = 0   '修改鼠标

  End Sub

Exit Sub

                                                                                                                               

err1:

本文由美高梅赌堵59599发布于首页,转载请注明出处: D.实现自动化功能,用到了一些VBA

关键词: