в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:47:42Z

1 версия

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

==Add a new workbook and save it==



<source lang="vb">

Public Sub SaveActiveWorkbook()
Application.Workbooks.Add
Call Application.ActiveWorkbook.SaveAs("temp.xls")
End Sub
</source>

==arranges the open workbooks in a tiled configuration==



<source lang="vb">

Private Sub AppEvent_NewWorkbook(ByVal Wb As Workbook)
Application.Windows.Arrange xlArrangeStyleTiled
End Sub
</source>

==Center workbook==



<source lang="vb">

Sub CenterBook()
Dim bookWidth As Integer
Dim bookHeight As Integer
bookWidth = Application.UsableWidth
bookHeight = Application.UsableHeight
ActiveWindow.WindowState = xlNormal
Workbooks("Center.xls").Windows(1).Width = bookWidth
Workbooks("Center.xls").Windows(1).Height = bookHeight
Workbooks("Center.xls").Windows(1).Left = 0
Workbooks("Center.xls").Windows(1).Top = 0
End Sub
</source>

==Check Whether a Sheet in an Open Workbook Exists==



<source lang="vb">

Function SheetExists(SName As String, Optional WB As workBook) As Boolean
Dim WS As Worksheet
If WB Is Nothing Then
Set WB = ActiveWorkbook
End If
On Error Resume Next
SheetExists = CBool(Not WB.Sheets(SName) Is Nothing)
On Error GoTo 0
End Function
Sub CheckForSheet()
Dim ShtExists As Boolean
ShtExists = SheetExists("Sheet1")
If ShtExists Then
MsgBox "The worksheet exists!"
Else
MsgBox "The worksheet does NOT exist!"
End If
End Sub
</source>

==Check Whether a Workbook Is Open==



<source lang="vb">

Function BookOpen(Bk As String) As Boolean
Dim T As Excel.workBook
Err.clear "clears any errors
On Error Resume Next
Set T = Application.Workbooks(Bk)
BookOpen = Not T Is Nothing

Err.clear
On Error GoTo 0
End Function
Sub OpenAWorkbook()
Dim IsOpen As Boolean
Dim BookName As String
BookName = "yourFile.xlsm"
IsOpen = BookOpen(BookName)
If IsOpen Then
MsgBox BookName & " is already open!"
Else
Workbooks.Open (BookName)
End If
End Sub
</source>

==Close a workbook and save it==



<source lang="vb">

Sub CloseWorkbook()
Dim Workbook1 As Workbook

Set Workbook1 = Workbooks.Open(FileName:=ThisWorkbook.Path & "\Temp.xls")
Range("A1").Value = Format(Date, "ddd mmm dd, yyyy")
Range("A1").EntireColumn.AutoFit
Workbook1.Close SaveChanges:=True
End Sub
</source>

==Controlling Worksheet Visibility==



<source lang="vb">

Sub SetWorksheetVisibility()
Dim myWorksheet As Worksheet
On Error Resume Next
Set myWorksheet = ThisWorkbook.Worksheets("Checks and Options")
Application.ScreenUpdating = False
ThisWorkbook.Worksheets("Sheet1").Visible = True
ThisWorkbook.Worksheets("Sheet2").Visible = True
ThisWorkbook.Worksheets("Sheet3").Visible = True
Application.ScreenUpdating = True
Set myWorksheet = Nothing
End Sub
</source>

==Count the Number of Workbooks in a Directory==



<source lang="vb">

Function NumFilesInCurDir(Optional strInclude As String = "")
Dim myFileSystemObject As FileSystemObject
Dim fld As folder
Dim fil As file
Dim subfld As folder
Dim intFileCount As Integer
Dim strExtension As String
strExtension = "XLS"
Set myFileSystemObject = New FileSystemObject
Set fld = myFileSystemObject.GetFolder(ThisWorkbook.Path)
For Each fil In fld.Files
If UCase(fil.name) Like "*" & UCase(strInclude) & "*." & UCase(strExtension) Then
intFileCount = intFileCount + 1
End If
Next fil
For Each subfld In fld.SubFolders
intFileCount = intFileCount + NumFilesInCurDir(strInclude)
Next subfld
NumFilesInCurDir = intFileCount
Set myFileSystemObject = Nothing
End Function
Sub CountMyWkbks()
Dim MyFiles As Integer
MyFiles = NumFilesInCurDir("MrE*")
MsgBox MyFiles & " file(s) found"
End Sub
</source>

==Create a new workbook==



<source lang="vb">

Sub NewWorkbooks()
Dim myWorkbook1 As Workbook
Dim myWorkbook2 As Workbook

Set myWorkbook1 = Workbooks.Add
Set myWorkbook2 = Workbooks.Add
Application.DisplayAlerts = False
myWorkbook1.SaveAs FileName:="E:\SalesData1.xls"
End Sub
</source>

==Create a workbook and save it as a new file==



<source lang="vb">

Public Sub SaveSpecificWorkbook2()

Dim W As Workbook
Set W = Application.Workbooks.Add
Call W.SaveAs("temp2.xls")

End Sub
</source>

==Creates a new workbook and adds it to the collection, reads the number of workbooks into a variable, and selects all worksheets in the active workbook:==



<source lang="vb">

Sub workbookAdd()
Workbooks.Add
numWorkbooks = Workbooks.Count
Worksheets.Select
End Sub
</source>

==Get workbook format==



<source lang="vb">

Sub GetFileFormat()
Dim lFormat As Long
Dim sFormat As String
Dim wb As Workbook
Set wb = ActiveWorkbook

lFormat = wb.FileFormat
Select Case lFormat
Case xlAddIn: sFormat = "Add-in"
Case xlCSV: sFormat = "CSV"
Case xlCSVMac: sFormat = "CSV Mac"
Case xlCSVMSDOS: sFormat = "CSV MS DOS"
Case xlCSVWindows: sFormat = "CSV Windows"
Case xlCurrentPlatformText: sFormat = "Current Platform Text"
Case xlDBF2: sFormat = "DBF 2"
Case xlDBF3: sFormat = "DBF 3"
Case xlDBF4: sFormat = "DBF 4"
Case xlDIF: sFormat = "DIF"
Case xlExcel2: sFormat = "Excel 2"
Case xlExcel2FarEast: sFormat = "Excel 2 Far East"
Case xlExcel3: sFormat = "Excel 3"
Case xlExcel4: sFormat = "Excel 4"
Case xlExcel4Workbook: sFormat = "Excel 4 Workbook"
Case xlExcel5: sFormat = "Excel 5"
Case xlExcel7: sFormat = "Excel 7"
Case xlExcel9795: sFormat = "Excel 97/95"
Case xlHtml: sFormat = "HTML"
Case xlIntlAddIn: sFormat = "Int"l AddIn"
Case xlIntlMacro: sFormat = "Int"l Macro"
Case xlSYLK: sFormat = "SYLK"
Case xlTemplate: sFormat = "Template"
Case xlTextMac: sFormat = "Text Mac"
Case xlTextMSDOS: sFormat = "Text MS DOS"
Case xlTextPrinter: sFormat = "Text Printer"
Case xlTextWindows: sFormat = "Text Windows"
Case xlUnicodeText: sFormat = "Unicode Text"
Case xlWebArchive: sFormat = "Web Archive"
Case xlWJ2WD1: sFormat = "WJ2WD1"
Case xlWJ3: sFormat = "WJ3"
Case xlWJ3FJ3: sFormat = "WJ3FJ3"
Case xlWK1: sFormat = "WK1"
Case xlWK1ALL: sFormat = "WK1ALL"
Case xlWK1FMT: sFormat = "WK1FMT"
Case xlWK3: sFormat = "WK3"
Case xlWK3FM3: sFormat = "WK3FM3"
Case xlWK4: sFormat = "WK4"
Case xlWKS: sFormat = "WKS"
Case xlWorkbookNormal: sFormat = "Normal workbook"
Case xlWorks2FarEast: sFormat = "Works 2 Far East"
Case xlWQ1: sFormat = "WQ1"
Case xlXMLSpreadsheet: sFormat = "XML Spreadsheet"
Case Else: sFormat = "Unknown format code"
End Select
Debug.Print sFormat
End Sub
</source>

==maximizes any workbook when it is activated==



<source lang="vb">

Private Sub AppEvent_WorkbookActivate(ByVal Wb as Workbook)
Wb.WindowState = xlMaximized
End Sub
</source>

==Open a workbook and then size it to fit just within the application window==



<source lang="vb">

Public Sub OpenBook()
Workbooks.Open ActiveWorkbook.Path & "\MyWorkbook.xls"
FitWindow
End Sub
Private Sub FitWindow()
Dim winWidth As Integer
Dim winHeight As Integer
winWidth = Application.UsableWidth "Get the usable width of app window
winHeight = Application.UsableHeight
End Sub
</source>

==Open workbook by name==



<source lang="vb">

Sub Array2()
Dim Data As Variant, myWorkbook As Workbook
Dim i As Integer
Data = Array("A", "B", "C", "D")
For i = LBound(Data) To UBound(Data)
Set myWorkbook = Workbooks.Open(FileName:=Data(i) & ".xls")
MsgBox myWorkbook.Name
myWorkbook.Close SaveChanges:=True
Next i
End Sub
</source>

==places the username in the footer of each sheet printed:==



<source lang="vb">

Private Sub AppEvent_WorkbookBeforePrint(ByVal Wb As Workbook,Cancel As Boolean)
Wb.ActiveSheet.PageSetup.LeftFooter = Application.UserName
End Sub
</source>

==Save workbook and close==



<source lang="vb">

Sub CloseWorkbook()
Dim myWorkbook1 As workBook

Set myWorkbook1 = Workbooks.Open(Filename:="E:\SalesData.xls")
Range("A1").Value = Format(Date, "ddd mmm dd, yyyy")
Range("A1").EntireColumn.AutoFit
myWorkbook1.Close SaveChanges:=True
End Sub
</source>

==The distinction between the Workbook and Window objects lies in an additional method that can be used to create a Window object==



<source lang="vb">

Sub newWindow()
Windows(1).newWindow
End Sub
</source>

==The Workbooks property is a member of the Application object and returns a reference to the Workbook object specified by the index value given in the parentheses.==



<source lang="vb">

Sub changePro()
Workbooks(1).Windows(1).WindowState = xlNormal
Workbooks(1).Windows(1).Width = 500
Workbooks(1).Windows(1).Height = 300
End Sub
</source>

==To close all open workbooks, use the Close method of the Workbooks collection object.==



<source lang="vb">

Sub closeDemo()
Workbooks.Close
End Sub
</source>

==To close a single workbook, use the Close method of the Workbook object. The Close method accepts three optional arguments (SaveChanges, FileName, and RouteWorkbook).==



<source lang="vb">

Sub save()
Workbooks("MyWorkbook.xls").Close SaveChanges:=False
End Sub
</source>

==To save a workbook from a VBA program, use either the Save methods of the Workbook object.==



<source lang="vb">

Sub saveWorkBook()
Workbooks("MyWorkbook.xls").save
End Sub
</source>

==To select the last Workbook object in the collection==



<source lang="vb">

Sub workbookSelect()
Workbooks(Workbooks.Count).Activate
End Sub
</source>

==Use Application object to save a workbook as a new file==



<source lang="vb">

Public Sub SaveSpecificWorkbook1()
Application.Workbooks.Add
Call Application.ActiveWorkbook.SaveAs("temp1.xls")
Application.Workbooks("temp1.xls").SaveAs ("copy of temp1.xls")
End Sub
</source>

==Use a String rather than an index value to reference a workbook==



<source lang="vb">

Sub workbookSelectName()
Workbooks("MyWorkbook.xls").Activate
End Sub
</source>

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

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

в 16:33, 26 мая 2010

Admin: 1 версия