в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:25Z

1 версия

Новая страница

==Get active workbook name only(without path name)==



<source lang="vb">

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
</source>

==Get next file name==



<source lang="vb">

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
</source>

==Get path of current work book==



<source lang="vb">

Sub workBook()
Debug.Print ThisWorkbook.Path
End Sub
</source>

==Get work book from same directory==



<source lang="vb">

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
</source>

==Is selected file open?==



<source lang="vb">

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
</source>

==Load excel file==



<source lang="vb">

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

==Open a text file for workbook==



<source lang="vb">

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
</source>

==Open Workbook file (xls file)==



<source lang="vb">

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

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



<source lang="vb">

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
</source>

==Save as the active workbook==



<source lang="vb">

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

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



<source lang="vb">

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
</source>

==tells you how many workbooks are open==



<source lang="vb">

Sub CountBooks()
MsgBox Workbooks.Count
End Sub
</source>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Excel/Workbook File - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия