Ответ :
Актуально только для MS Excel 97, 2000, XP
Для того, чтобы заблокировать все панели инструментов, включая собственные
панели и контекстные меню, а также убрать заголовок окна книги, изменить заголовок
окна приложения, убрать строку состояния, строку формул, сетку, заголовки столбцов,
вертикальную и горизонтальную полосу прокрутки, а также ярлычки листов, достаточно
выполнить макрос UserInterface() Для того, чтобы восстановить вид окна,
по умолчанию, достаточно выполнить макрос RestoreInterface()
Private Sub ChangeInterface(Value As Boolean)
With Application
.ScreenUpdating = False
.Caption = IIf(Value = True, Empty, "Наше окно")
.DisplayStatusBar = Value
.DisplayFormulaBar = Value
Dim iCommandBar As CommandBar
For Each iCommandBar In .CommandBars
iCommandBar.Enabled = Value
Next
With .ActiveWindow
.Caption = IIf(Value = True, .Parent.Name, "")
.DisplayHeadings = Value
.DisplayGridlines = Value
.DisplayHorizontalScrollBar = Value
.DisplayVerticalScrollBar = Value
.DisplayWorkbookTabs = Value
End With
.ScreenUpdating = True
End With
End Sub
Private Sub UserInterface()
ChangeInterface False
End Sub
Private Sub RestoreInterface()
ChangeInterface True
End Sub |
Ответ :
Актуально для MS Excel 2007
Если Вы пользовались более ранней версией, то, скорее всего,
замечали, что там высота строки формулы менялась автоматически, в зависимости
от количества(и ширины) символов активной ячейки. Однако, начиная с 2007
версии, всё изменилось и теперь подобного эффекта не наблюдается. И если
Вас это не устраивает и хочется самостоятельно изменять высоту строки формул,
то сделать это можно с помощью свойства FormulaBarHeight об'екта
Application
Application.FormulaBarHeight = 3 |
Комментарий : Обратите внимание на то, что высота - задаётся количеством строк.
Ответ : Актуально для MS Excel XP
Для того, что отобразить диалоговое окно, с помощью которого можно
выбрать необходимую папку и получить полный путь к этой папке, можно
использовать об'ект FileDialog, который впервые появился в MS Office XP.
Если же Вы работаете с другими версиями 97, 2000, то в этом случае можно
воспользоваться следующим советом
Private Sub GetSelectedFolder()
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count = 1 Then
iPath = .SelectedItems(1) '.InitialFileName
MsgBox "Выбрана папка : " & iPath, vbExclamation, ""
Else
MsgBox "Выберите нужную папку", vbCritical, ""
End If
End With
End Sub |
| Private Sub GetSelectedFolder()
With Application.FileDialog(msoFileDialogFolderPicker)
'.AllowMultiSelect = False
If .Show = True Then
iPath = .SelectedItems(1) '.InitialFileName
MsgBox "Выбрана папка : " & iPath, vbExclamation, ""
Else
MsgBox "Выберите нужную папку", vbCritical, ""
End If
End With
End Sub |
Ответ :
Если с помощью функции MsgBox, создаются сообщения,
которые содержат две или три кнопки и Вам необходимо, чтобы
основной была вторая или третья, то используйте константы
vbDefaultBitton2 и vbDefaultBitton3
Private Sub Example_MsgBox2()
If MsgBox("Есть ли жизнь на Марсе ?", _
vbYesNo + vbDefaultButton2) = vbNo Then
MsgBox "Выбрали 'Нет'"
Else
MsgBox "Выбрали 'Да'"
End If
End Sub |
| Private Sub Example_MsgBox3()
Select Case MsgBox("Ваш выбор ?", _
vbAbortRetryIgnore + vbDefaultButton3)
Case vbIgnore: MsgBox "Выбрали 'Пропустить'"
Case vbAbort: MsgBox "Выбрали 'Прервать'"
Case vbRetry: MsgBox "Выбрали 'Повтор'"
End Select
End Sub |
Комментарий : Если же необходимо, чтобы фокус находился
на первой кнопке, то несмотря на наличии константы vbDefaultBitton1,
её применение вовсе не обязательно.
Ответ :
Актуально для MS Excel 97-2003
Если Вы являетесь обладателем указанных выше версий, то для
вывода информации на экран, кроме функции MsgBox, Вы можете также
использовать возможности, которые предоставляет помошник, например :
Private Sub Assistant_NewBalloon()
With Assistant.NewBalloon
.Icon = msoIconTip
.Heading = "Заголовок подсказки"
.Text = "Текст подсказки"
.Show
End With
End Sub |
| Private Sub Assistant_NewBalloon2()
With Assistant.NewBalloon
'.Icon = msoIconAlertQuery
'.BalloonType = msoBalloonTypeButtons
.Button = msoButtonSetYesNoCancel
.Heading = "Выберите нужное действие"
.Text = "Продолжить ?"
Select Case .Show
Case -3: MsgBox "Кнопка Да"
Case -4: MsgBox "Кнопка Нет"
Case -2: MsgBox "Кнопка Отмена"
End Select
End With
End Sub |
Обратите внимание на то, что в отличии от функции MsgBox,
помошник(ассистент) позволяет нам несколько расширить взаимодействие с
пользователем, например, "создать" и использовать "флажки" или "надписи"
(нумерация которых, обязательно начинается с 1,
а количество ограничено 5)
| Private Sub Assistant_NewBalloon3()
Dim iCount%, iArrCity As Variant, iCheck As BalloonCheckbox
iArrCity = Array("Новосибирск", "Москва", "Ленинград", "Тверь", "Иркутск")
With Assistant.NewBalloon
.Heading = "Выберите нужные города"
For iCount = 0 To 4 'UBound(iArrCity)
.CheckBoxes(iCount + 1).Text = iArrCity(iCount)
Next
.Show
For Each iCheck In .CheckBoxes
If iCheck.Checked = True Then
MsgBox "Вы выбрали = " & iCheck.Text
End If
Next
End With
End Sub |
И наконец, помошник(ассистент) позволяет выводить немодальные
сообщения, пример создания и использование которых, также прилагается
(MsgBox, разумеется, применяются исключительно в демонстрационных целях)
| Private Sub Auto_Open() 'XL2000-2003
With Assistant
.On = True: '.Visible = True
With .NewBalloon
.BalloonType = msoBalloonTypeButtons
.Icon = msoIconAlertInfo
.Button = msoButtonSetNone
.Mode = msoModeModeless
.Callback = "PrintingUsingAssistant"
.Heading = "Вывести на печать ..."
.Labels(1).Text = "Выделенный диапазон"
.Labels(2).Text = "Выделенные листы"
.Labels(3).Text = "Всю книгу"
.Show
End With
.Animation = msoAnimationPrinting
End With
End Sub
Private Sub PrintingUsingAssistant(bln As Balloon, lbtn As Long, lPriv As Long)
bln.Close: Assistant.Visible = False
Select Case lbtn
Case 1: MsgBox "Выделенный диапазон"
Case 2: MsgBox "Выделенные листы"
Case 3: MsgBox "Всю книгу"
End Select
End Sub |
Ответ :
Актуально для MS Excel 97, 2000, XP
ThisWorkbook.FollowHyperlink Address:="http://www.msoffice.nm.ru" |
Примечание : Необходимо обязательно указать протокол, в
данном примере это http:// в противном случае возникнет ошибка,
кроме того, данную инструкцию желательно выполнять,
если Вы подключены к сети.
Ответ :
Актуально для MS Excel 97, 2000, XP
ThisWorkbook.FollowHyperlink Address:="mailto:excel_vs_calc@mail.com"
ThisWorkbook.FollowHyperlink _
Address:="mailto:excel_vs_calc@mail.com?subject=Excel" |
| Application.Dialogs(xlDialogSendMail).Show
Application.Dialogs(xlDialogSendMail).Show _
Arg1:="excel_vs_calc@mail.com", Arg2:="Calc" |
Примечание : Второй вариант позволяет отправить активную рабочую книгу
в виде вложения (attachment) и он может быть применён в MS Excel 95
Ответ :
Актуально для MS Excel 97, 2000
Для того, чтобы создать своё собственное сообщение о ошибке
(без создания нестандартных диалоговых окон имитирующих стандартное окно)
достаточно использовать метод Raise об'екта Err .
Err.Raise Number:=13, Description:="Не нужно вводить текст в столбец с датами"
|
Если же Вы хотите изменить, например, текст в стандартном сообщении, то это можно
осуществить также с помощью вышеупомянутого метода, например :
| Private Sub ErrorRaise()
On Error GoTo ErrHandler
iDivisor# = Application.InputBox(Title:="", Default:=0, _
Prompt:="Введите любое число, отличное от нуля", Type:=1)
iResult# = 100 / iDivisor#: Exit Sub
ErrHandler:
Select Case Err.Number
Case 11: Err.Raise Number:=Err.Number, _
Description:="Ну сколько можно повторять ... " & _
"что в таких случаях, перед делением, нужно проверять делитель на 0"
Case Else: Err.Raise Number:=Err.Number, _
Description:="Чудны дела твои ..."
End Select
End Sub |
Ответ :
Для того, чтобы в активном окне программно зафиксировать
области, причём без выделения ячеек, можно использовать функцию
ФИКСИРОВАТЬ.ПОДОКНА (макроязык Excel4.0)
Например, если мы хотим зафиксировать верхние три
строки окна, то это может выглядить так :
ExecuteExcel4Macro "FREEZE.PANES(TRUE,,3)" |
Важно : Имейте ввиду, что верхние три строки вовсе не
обязательно будут строками "1:3" Например, если после прокрутки,
на экране строки начинаются с 50-й, то макрос зафиксирует строки
"50:53" и если Вас это не устраивает, то перед фиксацией можно
осуществить прокрутку к первой строке, например так :
| ExecuteExcel4Macro "VSCROLL(0)"
ExecuteExcel4Macro "FREEZE.PANES(TRUE,,3)" |
Примечание : Вместо макрофунции ВПРОКРУТКА
допускается применение свойства .ScrollRow об'екта
Window , т.е.
|
ActiveWindow.ScrollRow = 1 |
Ответ :
Для того, чтобы запретить пользователю изменять размеры
активного окна, достаточно выполнить следующий код :
ActiveWindow.EnableResize = False |
Комментарий : Подобный запрет действует только для пользователя,
программно же изменить размеры активного окна, можно.
Ответ :
Для того, чтобы свернуть/развернуть окно приложения,
достаточно использовать свойство WindowState об'екта
Application .
Application.WindowState = xlMinimized
'Здесь должен быть код Вашей программы.
Application.WindowState = xlMaximized |
Ответ :
Для того, чтобы на время выполнение макроса скрыть приложение,
достаточно использовать свойство Visible об'екта
Application .
Application.Visible = False
'Здесь должен быть код Вашей программы.
Application.Visible = True |
Ответ :
Application.Quit |
Комментарий :
При наличии несохранённых изменений в открытых
рабочих книгах, на экран будет выведено стандартное диалоговое окно, предлагающее
сохранить изменения. Если появление этого сообщения нежелательно, то можно
сохранить все рабочие книги (конечно, если сохранение входит в Ваши планы)
Однако, при сохранении книги на экране могут появляться
и другие сообщения, например, о перезаписи существующего файла.
Кроме того, при сохранении книг(и), а также закрытии
приложения, а стало быть и всех открытых рабочих книг, будут вызваны события
Workbook_BeforeSave, Workbook_BeforeClose , которые могут отменить
сохранение и закрытие книги.
Стало быть, если Вы хотите избежать всех вышеперечисленных "неприятностей",
то имеет смысл недопустить вызов и выполнение этих событий
[FAQ157], а также отключить вывод
стандартных сообщений [FAQ16]
With Application
.EnableEvents = False
.DisplayAlerts = False
Dim iBook As Workbook '
For Each iBook In .Workbooks
iBook.Save
Next
.Quit
End With |
Если же Вам необходимо закрыть Excel, причём без сохранения изменений, то :
| With Application
.EnableEvents = False
.DisplayAlerts = False
.Quit
End With |
Ответ :
If Application.UserControl = True Then
MsgBox "Вы запустили программу вручную", , ""
Else
MsgBox "Программно : CreateObject/GetObject", , ""
End If |
| Dim XLApp As Excel.Application 'Object
Set XLApp = CreateObject("Excel.Application")
If XLApp.UserControl = True Then
MsgBox "Скорее всего, вручную ...", , ""
Else
MsgBox "Программно, т.е. CreateObject/GetObject", , "": XLApp.Quit
End If |
Примечание : Под программным, конечно же, подразумевается получение
доступа к об'екту только с помощью функций CreateObject/GetObject
Ответ :
iDecimalSeparator = Application.International(xlDecimalSeparator) |
Актуально для MS Excel XP
В этой версии появилась возможность использовать разделитель целой и
дробной части, отличный от системного, и в таких случаях свойство International
будет возвращать не системный разделитель, а тот, что используется в MS Excel.
Ответ :
iDateSeparator = Application.International(xlDateSeparator) |
Ответ :
iTimeSeparator = Application.International(xlTimeSeparator) |
Ответ :
Date = #9/8/04# ' "08.09.04" |
Пример того, как можно перевести "часы" на день вперед/назад. Один день,
конечно же, используется только в качестве примера.
| Private Sub SetSystemDate()
Date = Date + 1 '-1
'Date = DateAdd("d", 1, Date) 'DateAdd("d", -1, Date)
End Sub |
Ответ :
Time = #7:00:00 AM# ' "07:00:00"
Time = #7:00:00 PM# ' "19:00:00" |
Пример того, как можно перевести "часы" на три часа вперед/назад.
| Private Sub SetSystemTime()
Time = Time + (1 / 24 * 3) '- (1 / 24 * 3)
'Time = DateAdd("h", 3, Now) 'DateAdd("h", -3, Now)
'и т.д.
CreateObject("Shell.Application").SetTime 'просто демонстрация
End Sub |
Ответ :
Актуально для MS Excel 97, 2000, XP
Private Sub GetFonts()
With Application.CommandBars("Formatting")
If Not .FindControl(Id:=1728) Is Nothing Then
With .FindControl(Id:=1728)
ReDim iFonts$(1 To .ListCount)
For iCount% = 1 To .ListCount
iFonts$(iCount%) = .List(iCount%)
Next
End With
Else
MsgBox "Вы удалили контрол, который содержит список всех шрифтов"
End If
End With
End Sub
|
Ответ :
Актуально для MS Excel 97, 2000, XP
Для того, чтобы сохранить все .jpg или .gif файлы, которые могут
находиться в указанной(нужной) папке, в формате .bmp, можно создать пользовательскую
форму, разместить на ней элемент управления Рисунок - Image1 и скрыть этот
элемент управления установив значение Visible = False. Затем, по мере
необходимости, использовать свойство Picture , вкупе с функцией
LoadPicture и инструкцией SavePicture (см. пример)
Private Sub ConvertJPGtoBMP_Click()
With Application.FileSearch
.NewSearch
.SearchSubFolders = False 'True
.LookIn = ThisWorkbook.Path 'Укажите свою папку
.FileName = "*.jpg" '"*.jpeg" игнорируются 'XL97 - ".jpg"
.Execute
For iCount& = 1 To .FoundFiles.Count
iFileName$ = .FoundFiles(iCount&)
Me.Image1.Picture = LoadPicture(FileName:=iFileName$) ':DoEvents
'SetAttr iFileName$, vbNormal: Kill iFileName$
'Если необходимо удалить исходные файлы
Mid(iFileName$, Len(iFileName$) - 2, 3) = "bmp"
SavePicture Picture:=Me.Image1.Picture, FileName:=iFileName$
Next
End With
End Sub |
Комментарий : Если работы с диалоговым окном не предполагается, то просто
используйте инструкцию SavePicture и функцию LoadPicture
(см. ниже)
| Private Sub ConvertJPGtoBMP()
iPath$ = ThisWorkbook.Path & "\" 'Укажите свою папку
iFileName$ = Dir(iPath$ & "*.jpg") '"*.jpeg" игнорируются
Do While iFileName$ <> ""
SavePicture LoadPicture(iPath$ & iFileName$), _
iPath$ & Left(iFileName$, Len(iFileName$) - 3) & "bmp"
iFileName$ = Dir
Loop
End Sub |
Ответ :
Вариант I.
iFileName = "C:\Windows\Media\LogOff.wav"
iMacroFunction = "SOUND.PLAY(,""" & iFileName & """)"
ExecuteExcel4Macro iMacroFunction |
Если же необходимо программно определить был или нет воспроизведён звук, то
для этого можно воспользовать функцией IsSoundPlay, вызов которой приведён ниже.
| Private Sub Test()
iFileName$ = "C:\Windows\Media\LogOff.wav"
If IsSoundPlay(iFileName$) = True Then
MsgBox "Мы только что воспроизвели звук", , ""
Else
MsgBox "К сожалению, ничего не вышло", , ""
End If
End Sub
Private Function IsSoundPlay(iFileName$) As Boolean
iMacroFunction$ = "SOUND.PLAY(,""" & iFileName$ & """)"
IsSoundPlay = Not IsError(ExecuteExcel4Macro(iMacroFunction$))
End Function |
Вариант II.
Если на компьютере установлен Проигрыватель Windows Media Player, то,
в отличии от предыдущего варианта, Вы сможете прослушивать не только файлы .wav,
но и более популярный формат у "меломанов", а именно .mp3
|
CreateObject("MediaPlayer.MediaPlayer.1").Open "C:\Windows\Media\Tada.wav" 'Tada.wma
|
Допустим также и такой способ воспроизведения :
| With CreateObject("MediaPlayer.MediaPlayer.1")
.AutoStart = True
.FileName = "C:\Windows\Media\Music.mp3"
.Play
End With |
Обратите внимание на то, что Вы можете использовать и другие возможности
этого проигрывателя, к примеру, узнать причину отсутствия звука :
| With CreateObject("MediaPlayer.MediaPlayer.1")
.AutoStart = True
.Open "C:\Windows\Media\Music.mp3"
If .HasError = True Then MsgBox .ErrorDescription, , ""
End With |
Вариант III. Продолжение следует ...
Ответ :
iComputerName = Environ("ComputerName") |
Важно : Подобная возможность определения имени компьютера впервые
появилась только в Windows 2000 и если Вы являетесь обладателем
более ранней версии, то используйте другие способы :
FAQ303,
FAQ333,
FAQ506
Ответ :
iUserName = Environ("UserName") |
Важно : Подобная возможность определения имени компьютера впервые
появилась только в Windows 2000 и если Вы являетесь обладателем
более ранней версии, то используйте другие способы :
FAQ334,
FAQ335,
FAQ506
Ответ :
Для того, чтобы получить значение переменной среды, можно
воспользоваться функцией Environ() , например
FAQ145,
FAQ504,
FAQ502, FAQ503
Для получения же списка всех доступных переменных
среды Вашей операционной системы, можно воспользоваться
нижеопубликованным макросом :
Private Sub CreateListEnvironVariables()
Workbooks.Add xlWBATWorksheet '[2]
Application.ScreenUpdating = False '[1]
iCount% = 2: iVariable$ = Environ(1)
Do Until iVariable$ = ""
iPosition% = InStr(iVariable$, "=")
Cells(iCount%, 1) = Mid(iVariable$, 1, iPosition% - 1)
Cells(iCount%, 2) = Mid(iVariable$, iPosition% + 1)
iVariable$ = Environ(iCount%)
iCount% = iCount% + 1
Loop
With Cells(1).Resize(, 2) 'Range("A1:B1")
.Value = Array("Имя", "Значение")
.Font.Bold = True
.EntireColumn.AutoFit
End With
Application.ScreenUpdating = False
End Sub |
Ответ :
Для того, чтобы создать новый или изменить уже существующий раздел и
запись в реестре Windows, можно использовать инструкцию SaveSetting .
SaveSetting AppName:="UserForm1", Section:="TextBox1", _
Key:="Value", Setting:="Введите номер заказа" 'Or
SaveSetting "UserForm1", "TextBox1", "Tag", "123"
SaveSetting "UserForm1", "Label1", "Caption", "Номер заказа:" |
Комментарий : Данная инструкция позволяет работать только с одним
разделом реестра, а именно :
HKEY_USERS\...\VB and VBA Program Settings\... 'Win98/WinMe
HKEY_CURRENT_USER\...\VB and VBA Program Settings\... 'Win2000/WinXP
Ответ :
Для того, чтобы получить значение нужной записи из раздела в реестре
Windows, можно воспользоваться функцией GetSetting .
iSetting = GetSetting(AppName:="UserForm1", Section:="TextBox1", Key:="Value") 'Or
'iSetting = GetSetting("UserForm1", "TextBox1", "Value") |
Примечание : Если искомое значение определено не будет, например, в случае
отсутствия указанного приложения, раздела, записи, то данная функция возвращает
значение необязательного именованного аргумента Default. Поскольку, в данном примере,
этот аргумент не используется, функция возвращает пустую строку, однако, это довольно
легко изменить.
|
iSetting = GetSetting(AppName:="UserForm1", _
Section:="TextBox2", Key:="Value", Default:="Текст, по умолчанию") 'Or
'iSetting = GetSetting("UserForm1", "TextBox2", "Value", "Текст, по умолчанию")
|
Комментарий : Данная функция позволяет работать только с одним
разделом реестра, а именно :
HKEY_USERS\...\VB and VBA Program Settings\... 'Win98/WinMe
HKEY_CURRENT_USER\...\VB and VBA Program Settings\... 'Win2000/WinXP
Ответ :
Для того, чтобы получить список всех значений и записей указанного раздела,
достаточно воспользоваться функцией GetAllSettings . Обратите внимание
на то, что эта функция возвращает двумерный массив (тип Variant), первый столбец
которого, содержит имена всех записей указанного раздела, а второй столбец содержит
значения всех записей. Однако, если Вы попытаетесь получить список записей и их
значений, для несуществующей ветки или раздела, то тогда функция GetAllSettings
возвратит значение Empty (Пусто)
iAllSettings = GetAllSettings(AppName:="UserForm1", Section:="TextBox1") 'Or
'iAllSettings = GetAllSettings("UserForm1", "TextBox1")
If Not IsEmpty(iAllSettings) Then
For iCount = 0 To UBound(iAllSettings)
MsgBox _
"Имя записи : " & iAllSettings(iCount, 0) & vbCrLf & _
"Значение : " & iAllSettings(iCount, 1)
Next
End If |
Комментарий : Данная функция также позволяет работать только с одним
разделом реестра :
HKEY_USERS\...\VB and VBA Program Settings\... 'Win98/WinMe
HKEY_CURRENT_USER\...\VB and VBA Program Settings\... 'Win2000/WinXP
Ответ :
Для того, чтобы удалить ненужную запись или раздел в реестре Windows,
можно воспользоваться инструкцией DeleteSetting .
DeleteSetting AppName:="UserForm1", Section:="TextBox1", Key:="Value"
'DeleteSetting "UserForm1", "TextBox1", "Value"
DeleteSetting AppName:="UserForm1", Section:="TextBox1"
'DeleteSetting "UserForm1", "TextBox1" |
Комментарий : И эта инструкция, конечно же, позволяет удалять
ненужные записи только в одном разделе реестра :
HKEY_USERS\...\VB and VBA Program Settings\... 'Win98/WinMe
HKEY_CURRENT_USER\...\VB and VBA Program Settings\... 'Win2000/WinXP
| | | | | | | | | | | | | | | | | | | | | | | | | | | | | | |