VBA 文件操作

'excel文件和工作簿

excel文件就是excel工作簿，excel文件打开需要excel程的支持

'Workbooks 工作簿集合，泛指excel文件或工作簿

'Workbooks("A.xls")，名称为A的excel工作簿

     Sub t1()
        Workbooks("A.xls").Sheets(1).Range("a1") = 100
     End Sub

workbooks(2)，按打开顺序，第二个打开的工作簿。

      Sub t2()
        Workbooks(2).Sheets(2).Range("a1") = 200
     End Sub

ActiveWorkbook ，当打开多个excel工作簿时，你正在操作的那个就是ActiveWorkbook（活动工作簿）

 

Thisworkbook，VBA程序所在的工作簿，无论你打开多少个工作簿，无论当前是哪个工作簿是活动的,thisworkbook就是指它所在的工作簿。

'工作簿窗口

'Windows("A.xls"),A工作簿的窗口，使用windows可以设置工作簿窗口的状态，如是否隐藏等。

 Sub t3()
        Windows("A.xls").Visible = False
     End Sub
     Sub t4()
        Windows(2).Visible = True
     End Sub

1 判断A.Xls文件是否存在

    Sub W1()
     If Len(Dir("d:/A.xls")) = 0 Then
       MsgBox "A文件不存在"
     Else
       MsgBox "A文件存在"
     End If
   End Sub

'2 判断A.Xls文件是否打开

    Sub W2()
     Dim x As Integer
      For x = 1 To Windows.Count
        If Windows(x).Caption = "A.XLS" Then
          MsgBox "A文件打开了"
          Exit Sub
        End If
      Next
    End Sub

3 excel文件新建和保存

  Sub W3()
     Dim wb As Workbook
     Set wb = Workbooks.Add
       wb.Sheets("sheet1").Range("a1") = "abcd"
     wb.SaveAs "D:/B.xls"
  End Sub

4 excel文件打开和关闭

 Sub w4()
    Dim wb As Workbook
    Set wb = Workbooks.Open("D:/B.xls")
    MsgBox wb.Sheets("sheet1").Range("a1").Value
    wb.Close False
 End Sub

5 excel文件保存和备份

   Sub w5()
      Dim wb As Workbook
      Set wb = ThisWorkbook
      wb.Save
      wb.SaveCopyAs "D:/ABC.xls"
   End Sub

6 excel文件复制和删除

   Sub W6()
      FileCopy "D:/ABC.XLS", "E:/ABCd.XLS"
      Kill "D:/ABC.XLS"
   End Sub

 

工作表

概念

'excel工作表的分类

'excel工作表有两大类，一类是我们平常用的工作表(worksheet)，另一类是图表、宏表等。这两类的统称是sheets

'sheets 工作表集合，泛指excel各种工作表

'Sheets("A")，名称为A的excel工作表
Sub t1()
Sheets("A").Range("a1") = 100
End Sub

 

'workbooks(2)，按打开顺序，第二个打开的工作簿。

Sub t2()
Sheets(2).Range("a1") = 200
End Sub

'ActiveSheet ，当打开多个excel工作簿时，你正在操作的那个就是ActiveSheet

1 判断A工作表文件是否存在

    Sub s1()
     Dim x As Integer
      For x = 1 To Sheets.Count
        If Sheets(x).Name = "A" Then
          MsgBox "A工作表存在"
          Exit Sub
        End If
      Next
      MsgBox "A工作表不存在"
    End Sub

2 excel工作表的插入

  Sub s2()
     Dim sh As Worksheet
     Set sh = Sheets.Add
       sh.Name = "模板"
       sh.Range("a1") = 100
  End Sub

'3 excel工作表隐藏和取消隐藏

 Sub s3()
    Sheets(2).Visible = True
 End Sub

4 excel工作表的移动

   Sub s4()
     Sheets("Sheet2").Move before:=Sheets("sheet1") 'sheet2移动到sheet1前面
     Sheets("Sheet1").Move after:=Sheets(Sheets.Count) 'sheet1移动到所有工作表的最后面
   End Sub

6 excel工作表的复制

   Sub s5() '在本工作簿中
      Dim sh As Worksheet
      Sheets("模板").Copy after:=Sheets(Sheets.Count)
       Set sh = ActiveSheet
          sh.Name = Sheets.Count & "日"
          sh.Range("a1") = "测试"
   End Sub

7 另存新的工作薄

   Sub s6() '另存为新工作簿
      Dim wb As Workbook
       Sheets("模板").Copy
       Set wb = ActiveWorkbook
          wb.SaveAs ThisWorkbook.Path & "/1日.xls"
          wb.Sheets(1).Range("b1") = "测试"
          wb.Close True
   End Sub

'7 保护工作表

   Sub s7()
      Sheets("sheet2").Protect "123"
   End Sub

   Sub s8() '判断工作表是否添加了保护密码
      If Sheets("sheet2").ProtectContents = True Then
        MsgBox "工作簿保护了"
      Else
        MsgBox "工作簿没有添加保护"
      End If
   End Sub

 '8 工作表删除

     Sub s9()
       Application.DisplayAlerts = False
         Sheets("模板").Delete
       Application.DisplayAlerts = True
     End Sub

'9 工作表的选取

     Sub s10()
       Sheets("sheet2").Select
     End Sub

 

例题 

题 1

复制“日报表模板”工作表(已隐藏)至本工作簿最后一个位置，复制后的工作表名称为最后的日期天数+1&"报表"的格式。
如：
当前情况下，没有任何一天的日报表，则新复制的工作表名称是“1日报表”，如果再添加时就是1+1=2日报表。如果目前已存在5天的日报表，则复制后的工作表名称应为“6日报表”

注：“日报表模板”工作表复制后要隐藏起来

Sub 日报表格式生成()
Dim msh As Worksheet, shname$
Application.ScreenUpdating = False
Set msh = Sheets("日报表模板")
shname = Sheets(Sheets.Count).Name
With msh
    .Visible = xlSheetVisible
    .Copy after:=Sheets(Sheets.Count)
    .Visible = xlSheetHidden
End With
If shname = msh.Name Or shname = "第1题" Then
    ActiveSheet.Name = 1 & "日报表"
Else
    ActiveSheet.Name = Left(shname, Len(shname) - 3) + 1 & "日报表"
End If
Application.ScreenUpdating = True
End Sub

题目２:

把所有日报表另存为工作簿到本文夹下，工作簿名称为工作表的名称

Sub 另存报表()
Dim ish As Worksheet, myname$
Application.ScreenUpdating = False
For Each ish In ThisWorkbook.Worksheets
myname = ish.Name
If myname <> "第1题" And myname <> "日报表模板" Then
    ish.Move
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "/" & myname & ".xls"
    ActiveWorkbook.Close
End If
Next
Application.ScreenUpdating = True
End Sub