VBA/Excel/Access/Word/Excel/Workbook File — различия между версиями
Admin (обсуждение | вклад) м (1 версия) |
|
(нет различий)
|
Версия 16:33, 26 мая 2010
Содержание
- 1 Get active workbook name only(without path name)
- 2 Get next file name
- 3 Get path of current work book
- 4 Get work book from same directory
- 5 Is selected file open?
- 6 Load excel file
- 7 Open a text file for workbook
- 8 Open Workbook file (xls file)
- 9 Presents user with a GetOpenFileName dialog that allows multiple file selection.
- 10 Save as the active workbook
- 11 Save changes automatically, specify this as a parameter of the Close method
- 12 tells you how many workbooks are open
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