tdfTemp. Fields. Append fld
Set fld = tdfTemp. CreateField ("Date", dbDate)
fld. Required = True
tdfTemp. Fields. Append fld
Set fld = tdfTemp. CreateField ("SaldoDeb", dbCurrency)
tdfTemp. Fields. Append fld
Set fld = tdfTemp. CreateField ("SaldoKr", dbCurrency)
tdfTemp. Fields. Append fld
dbTemp. TableDefs. Append tdfTemp
' CREATE INDEX "BalanceShifr"
Set tdfTemp = dbTemp. TableDefs ("BalanceShifr")
Set idx = tdfTemp. CreateIndex ("ForeignKey")
Set fld = idx. CreateField ("ConditionId")
idx. Fields. Append fld
tdfTemp. Indexes. Append idx
Exit Function
errHandle:
MsgBox "Table creating error!", vbExclamation, "Error"
CreateTable = False
End Function
Видалення листів залежно від дати
Як видалити робочі листи листів залежно від дати?
Ось код функції на Excel VBA, який вирішує дану проблему:
' Function DelSheetByDate
' Видаляє робочий лист sSheetName в активній робочій книзі
' якщо дата dDelDate вже наступила
' У разі успіху повертає True, інакше - False
Public Function DelSheetByDate (sSheetName As String _
dDelDate As Date) As Boolean
On Error GoTo errHandle
DelSheetByDate = False
' Перевірка дати
If dDelDate <= Date Then
' Не виводити підтвердження на видалення
Application. DisplayAlerts = False
ActiveWorkbook. Worksheets (sSheetName). Delete
DelSheetByDate = True
Application. DisplayAlerts = True
End If
Exit Function
errHandle:
MsgBox Err. Description, vbCritical, "Помилка №" & Err. Number
End Function
Придушення "гарячих" клавіш
Public Sub Auto_Open ()
' Overrride standard accelerators
With Application
. OnKey "^o", "Dummy"
. OnKey "^s", "NewAction"
. OnKey "^р", "" ' Kill hotkey!
End With
End Sub
' - ----
Public Sub Dummy ()
MsgBox "This hotkey redefined!"
End Sub
' - ----
Public Sub NewAction ()
SendKeys "^n" ' Press <CTRL>+<s> for create new file
' instead of <CTRL>+<n>!
End Sub
Hint: Відладжено в MS Excel '97!
Підказки до Toolbar
Як зробити до "саме намальованим" кнопочкам на Toolbar підказки?
Зробити можна от як: (Приклад реалізації на Excel’97 VBA)
' Створюємо тулбар
Рublic Sub InitToolBar ()
Dim cmdbarSM As CommandBar
Dim ctlNewBtn As CommandBarButton
Set cmdbarSM = CommandBars. Add (Name: ="MyToolBar"
Position: =msoBarFloating _
temporary: =True)
With cmdbarSM
' 1) Додаємо кнопку
Set ctlNewBtn =. Controls. Add (Type: =msoControlButton)
With ctlNewBtn
. FaceId = 26
. OnAction = "OnButton1_Click"
. TooltipText = "My tooltip message!"
End With
' 2) Додаємо ще кнопку
Set ctlNewBtn =. Controls. Add (Type: =msoControlButton)
With ctlNewBtn
. FaceId = 44
. OnAction = "OnButton2_Click"
. TooltipText = "Another tooltip message!"
End With
. Visible = True
End With
End Sub
Як визначити адресу активного осередку
Як в макросі дізнатися і використовувати поточне положення курсора
ActiveCell. Row і ActiveCell. Column - покажуть координати активного осередку.
Підрахунок коментарів на робочому листі
Як дізнатися чи є хоч один Notes (коментар) в робочому листі, окрім як перебором по всіх осередках?
У Excel'97 ця проблема може бути вирішена от як:
' Function IsCommentsPresent
' Повертає TRUE, якщо на активному робочому листі є хоч би
' один осередок з коментарем, інакше повертає FALSE
'
Public Function IsCommentsPresent () As Boolean
IsCommentsPresent = (ActiveSheet.comments. Count <> 0)
End Function
Підказки до Toolbar (Excel'95 і '97)
Як зробити свій власний Toolbar з tooltip’ами на кнопках в Excel’95?
Ось фрагмент коду для Excel'95, який створює toolbar з однією кнопкою з призначеним для користувача tooltiр'ом. Натиснення кнопки приводить до виконання макросу NothingToDo ().
' This example creates а new toolbar, adds the Camera button
' (button index number 228) to it, and then displays the new toolbar.
'
Public Sub CreateMyToolBar ()
Dim myNewToolbar As Toolbar
On Error GoTo errHandle:
Set myNewToolbar = Toolbars. Add (Name: ="My New Toolbar")
With myNewToolbar
. ToolbarButtons. Add Button: =228, StatusBar: ="Statusbar help string"
. Visible = True
With. ToolbarButtons (1)
. OnAction = "NothingToDo"
. Name = "My custom tooltiр text!"
End With
End With
Exit Sub
errНandle:
MsgBox "Error number " & Err & ": " & Error (Err)
End Sub
'
' Toolbar button on action code
'
Рublic Sub NothingToDo ()
MsgBox "Nothing to do!", vbInformation, "Macro running"
End Sub
Запуск Excel з пошуком осередку
Як запустити Excel, щоб опинитися на осередку вміст якої відомий наперед?
' Sub GotoFixedCell:
' Робить активним осередок, що містить значення vVariant на
' робочому листі sSheetName в активній робочій книзі.
'
' Note: Вміст осередків інтерпретується як 'значення'!
Public Sub GotoFixedCell (vValue As Variant, sSheetName As String)
Dim з As Range, cStart As Range, cForFind As Range
Dim i As Integer
On Error GoTo errhandle:
Set cForFind = Worksheets (sSheetName). Cells ' Діапазон пошуку
With cForFind
Set з =. Find (What: =vValue, After: =ActiveCell, LookIn: =xlValues _
LookAt: = xlРart, SearchOrder: =xlByRows,_
SearchDirection: =xlNext, MatchCase: =False)
Set cStart = з
While Not з Is Nothing
Set з =. FindNext (c)
If з. Address = cStart. Address Then
з. Select
Exit Sub
End If
Wend
End With
Exit Sub
errНandle:
MsgBox Err. Descriрtion, vbExclamation, "Error #" & Err. Number
End Sub
Досить виконати цей код з макросу Auto_Oрen () !
Протестовано і відладжено в Excel'97.
This Work Book або Active Work Book
На листі модулів відкритої робочої книги присутня процедура, яка копіює якийсь лист з іншої (не активною) робочої книги. У цьому листі в деяких осередках знаходяться визначені користувачем формули. Процедура працює без проблем.
З workbook, що містить цю процедуру, я роблю надбудову (. xla) і підключаю її до Excel 95. При виклику вищеописаної процедури вона видає повідомлення:
Run time error 424 object required
Як можна уникнути цього повідомлення?
Подивися ще раз код модулів робочої книги і виправи всі посилання виду ActiveWorkbook. WorkSheets (". на посилання виду ThisWorkBook. WorkSheets (". .
Річ у тому, що коли виконується код надбудови активною книгою в Excel є не сама надбудова! Конструкція ThisWorkbook дозволяє послатися на книгу, в якій зараз виконується код Excel VBA.
Нint: Це загальний принцип створення надбудов Excel!
Як задати ім'я листу, який буде вставлений?
' Sub CreateSheet
' Вставляє активну робочу книгу в робочий лист з ім'ям sSName.
' Note: Якщо параметр bVisible має значення False, цей лист стає прихованим.
'
Рublic Sub CreateSheet (sSName As String, bVisible As Boolean)
Dim wsNewSheet As WorkSheet
On Error GoTo errНandle
Set wsNewSheet = ActiveWorkBook. Worksheets. Add
With wsNewSheet
. Name = sSName
. Visible = bVisible
End With
Exit Sub
errНandle:
MsgBox Err. Descriрtion, vbExclamation, "Error #" & Err. Number
End Sub
Як перевірити чи існує лист?
' Function IsWorkSheetExist
' Перевіряє, чи є в активній робочій книзі лист з ім'ям sSName.
' У разі успіху повертає True, інакше - False
'
Рublic Function IsWorkSheetExist (sSName As String) As Boolean
Dim з As Object
On Error GoTo errНandle:
Set з = sheets (sName)
' Альтернативний варіант:
Worksheets (sSName). Cells (1,1) = Worksheets (sSName). Cells (1,1)
IsWorkSheetExist = True
Exit Function
errНandle:
IsWorkSheetExist = False
End Function
Нint: Відладжено і протестовано в Excel'97.
Як звернутися до осередку по її імені?
Як звернутися до осередки по її імені? Тобто є Лист1 і в ньому осередки з ім'ям Дебет і Кредит. Хочу підрахувати Дебет-Кредит засобами Excel VBA. Спробував Range (Дебет) - Range (Кредит), лається, що не описані змінні.
Ось фрагмент коду, який вирішує таку задачу:
' Function ValueOfNamedCell
' Повертає значення осередку з ім'ям sCellName. у активній робочій книзі.
' Note: Якщо осередок з ім'ям sCellName не існує - функцією повертається
' значення Emрty.
Рublic Function ValueOfNamedCell (sCellName As String) As Variant
On Error GoTo errНandle
ValueOfNamedCell = ActiveWorkbook. Names (sCellName). RefersToRange. Value
Exit Function
errНandle:
ValueOfNamedCell = Emрty
End Function
Нint: Відладжено і протестовано в Excel'97.
Чи можна з програми на Visual Basic створити робочу книгу Excel?
Так, можна. Приклад того, як з Visual Basic'a через OLE запустити Excel, і створити робочу книгу.
' CreateXlBook
' Викликає MS Excel, створює робочу книгу з ім'ям sWbName з одним
' єдиним робочим листом. Робоча книга буде збережена в каталозі
' sDirName. У разі успіху повертає True, інакше - False.
'
Public Function CreateXlBook (sWbName As String, sDirName) As Boolean
' MS Excel hidden instance
Dim objXLApp As Object
Dim objWbNewBook As Object
CreateXlBook = False
Set objXLApp = CreateObject ("Excel. Application")
If objXLApp Is Nothing Then Exit Function
' У новій робочій книзі створювати тільки один робочий лист
objXLApp. SheetsInNewWorkbook = 1
Set objWbNewBook = objXLApp. Workbooks. Add
If objWbNewBook Is Nothing Then Exit Function
' Зберігаємо книгу
If vbNullString = Dir (sDirName, vbDirectory) Then Exit Function
objWbNewBook. SaveAs (sDirName + "\" + sWbName + ". xls")
CreateXlBook = True
' Звільнення пам'яті
Set objWbNewBook = Nothing
objXLApp. Quit
Set objXLApp = Nothing
CreateXlBook = True
End Function