VBA/Excel/Access/Word/Excel/Workbook File

Материал из VB Эксперт
Версия от 12:47, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

Get active workbook name only(without path name)

 
Sub GetFileName()
  Dim BackSlash As Integer, Point As Integer
  Dim FilePath As String, FileName As String
  Dim i As Integer
  
  FilePath = ActiveWorkbook.FullName
  For i = Len(FilePath) To 1 Step -1
    If Mid$(FilePath, i, 1) = "." Then
      Point = i
      Exit For
    End If
  Next i
  If Point = 0 Then Point = Len(FilePath) + 1
  For i = Point - 1 To 1 Step -1
    If Mid$(FilePath, i, 1) = "\" Then
      BackSlash = i
      Exit For
    End If
  Next i
  Debug.Print Mid$(FilePath, BackSlash + 1, Point - BackSlash - 1)
  
End Sub



Get next file name

 
Public Sub CreateNextFileName()
  Dim Workbook1 As Workbook
  Dim I As Integer
  Dim FileName As String
  
  Set Workbook1 = Workbooks.Add(Template:=ThisWorkbook.Path & "\Temp.xls")
  I = 0
  Do
    I = I + 1
    FileName = ThisWorkbook.Path & "\Temp" & I & ".xls"
  Loop While FileExists(FileName)
   
  Workbook1.SaveAs FileName:=FileName
End Sub



Get path of current work book

 
Sub workBook()
    Debug.Print ThisWorkbook.Path
End Sub



Get work book from same directory

 
Sub ActivateWorkbook2()
   Dim stPath As String
   Dim myFileName As String
   Dim stFullName As String
   Dim myWorkbook As workBook
   myFileName = "SalesData1.xls"
   stPath = ThisWorkbook.Path
   stFullName = stPath & "\" & myFileName
   Set myWorkbook = Workbooks.Open(Filename:=stFullName)
End Sub



Is selected file open?

 
Sub IsWorkbookOpen()
   Dim myWorkbook As Workbook
   Dim stName As String
 
   stName = "c:\abc.xls"
   On Error Resume Next
   Set myWorkbook = Workbooks(stName)
   If Not myWorkbook Is Nothing Then
      MsgBox True
   End If
  
   MsgBox False
End Sub



Load excel file

 
Sub LoadExcelFile()
  Dim result As Variant
  result = Application.GetOpenFilename("Excel files,*.xl?", 1)
  If result = False Then Exit Sub
  Workbooks.Open result
End Sub



Open a text file for workbook

 
Public Sub OpenTextTest()
  Dim FileName As String
  FileName = ThisWorkbook.Path & "\Data.txt"
  Call Workbooks.OpenText(FileName:=FileName, DataType:=xlDelimited, Tab:=True, DecimalSeparator:=",", ThousandsSeparator:=".")
End Sub



Open Workbook file (xls file)

 
Sub ActivateWorkbook1()
   Dim stFullName As String
   Dim myWorkbook As Workbook
   stFullName = "c:\SalesData1.xls"
   Set myWorkbook = Workbooks.Open(Filename:=stFullName)
End Sub



Presents user with a GetOpenFileName dialog that allows multiple file selection.

 
Sub main()
   GetExcelFiles ("YourTitle")
End Sub
Function GetExcelFiles(sTitle As String) As Variant
    Dim sFilter As String
    Dim bMultiSelect As Boolean
    sFilter = "Workbooks (*.xls), *.xls"
    bMultiSelect = True
    GetExcelFiles = Application.GetOpenFilename(FileFilter:=sFilter, _
        Title:=sTitle, MultiSelect:=bMultiSelect)
End Function



Save as the active workbook

 
Sub saveAsDemo()
   ActiveWorkbook.SaveAs FileName:="c:\MyFile.xls"
End Sub



Save changes automatically, specify this as a parameter of the Close method

 
     Sub CloseWorkbook()
           Dim myWorkbook1 As Workbook
           Set myWorkbook1 = Workbooks.Open(FileName:="C:\Data\SalesData1.xlsx")
           Range("A1").Value = Format(Date, "ddd mmm dd, yyyy")
           Range("A1").EntireColumn.AutoFit
           myWorkbook1.Close SaveChanges:=True
     End Sub



tells you how many workbooks are open

 
Sub CountBooks()
      MsgBox Workbooks.Count
End Sub