ЛЕБЕДКО ЛАБ / Лабка 1
.docОтчет ЛЕБЕДКО И.А.
ЗФ ИСиТ 3 курс
Лабораторная №1
Открывл Microsoft Excel, комбинацией клавиш alt+F11 вызываю окно Microsoft Visual Basic for Applications, Insert→UserForm– создаю заданную форму:
Для того, что бы данная форма появлялась и пропадала по комбинации клавиш ctrl+x создадим макрос с названием MacroS , в ячейке с адресом А1. Вид → макросы → Запись макроса.Делаю данную ячейку активной , затем Макрос → Остановить.
Прописываем код:
SubMacroS()
'
' MacroS Макрос
'
' Сочетание клавиш: Ctrl+u
'
Range("A1").Select
If (UserForm1.Visible = False) Then
UserForm1.Show
EndIf
EndSub
Кодируем клавишу Close:
Private Sub CommandButton7_Click()
Me.Hide
EndSub
Теперь форма появляется при нажатии ctrl+u и пропадает при нажатии Close.
Кодируем клавишу GetCurrent Direcory:
Private Sub CommandButton6_Click()
Dim buffer As String * 255
Dim retValue
retValue = GetCurrentDirectory(255, buffer)
TextBox1.Text = buffer
End Sub
Кодируем клавишу CreateDir:
Private Sub CommandButton1_Click()
X = InputBox("Введи полный путь с именем папки, напр. e:\work\my_dir")
' функция получает в качестве параметра путь к папке
' если такой папки ещё нет - она создаётся
' может создаваться сразу несколько подпапок
If Len(Dir(X, vbDirectory)) = 0 Then ' еслипапкаотсутствует
SHCreateDirectoryExApplication.hwnd, X, ByVal 0& ' создаёмпапку
MsgBox "Папка создана"
Else
MsgBox "Папка уже существует"
EndIf
EndSub
Кодируем клавишу ShowFiles:
Private Sub CommandButton2_Click()
Dim FolderPathAs String
FolderPath = Trim(TextBox1.Text)
FilenamesCollection (FolderPath)
End Sub
Function FilenamesCollection(ByValFolderPath As String, Optional ByVal Mask As String = "", _
Optional ByValSearchDeepAs Long = 999) As Collection
' Получает в качестве параметра путь к папке FolderPath,
' маску имени искомых файлов Mask (будут отобраны только файлы с такой маской/расширением)
' и глубину поиска SearchDeep в подпапках (если SearchDeep=1, то подпапки не просматриваются).
' Возвращает коллекцию, содержащую полные пути найденных файлов
' (применяется рекурсивный вызов процедуры GetAllFileNamesUsingFSO)
If (FolderPath = "") Then
MsgBox "Папканеопределена"
Else
Set FilenamesCollection = New Collection ' создаём пустую коллекцию
Set FSO = CreateObject("Scripting.FileSystemObject") ' создаёмэкземплярFileSystemObject
GetAllFileNamesUsingFSOFolderPath, Mask, FSO, FilenamesCollection, SearchDeep ' поиск
Set FSO = Nothing: Application.StatusBar = False ' очистка строки состояния Excel
End If
End Function
Function GetAllFileNamesUsingFSO(ByValFolderPath As String, ByVal Mask As String, ByRef FSO, _
ByRefFileNamesCollAs Collection, ByValSearchDeep As Long)
' перебирает все файлы и подпапки в папке FolderPath, используя объект FSO
' перебор папок осуществляется в том случае, если SearchDeep> 1
' добавляет пути найденных файлов в коллекцию FileNamesColl
On Error Resume Next: Set curfold = FSO.GetFolder(FolderPath)
If Not curfold Is Nothing Then ' если удалось получить доступ к папке
For Each filIncurfold.Files ' перебираем все файлы в папке FolderPath
If fil.Name Like "*" & Mask Then
ListBox1.AddItem (fil.Path)
End If
Next
SearchDeep = SearchDeep - 1 ' уменьшаем глубину поиска в подпапках
IfSearchDeepThen ' если надо искать глубже
ForEachsfolIncurfold.SubFolders ' перебираем все подпапки в папке FolderPath
GetAllFileNamesUsingFSOsfol.Path, Mask, FSO, FileNamesColl, SearchDeep
Next
End If
Set fil = Nothing: Set curfold = Nothing ' очищаем переменные
EndIf
EndFunction
Прописываем код для 1111FileDialog
Private Sub CommandButton4_Click()
CommonDialog1.ShowOpen
If CommonDialog1.FileName <> "" Then
FileName = CommonDialog1.FileName
End If
TextBox1.Text = FileName
End Sub
Клавиша DeleteFile
Private Sub CommandButton5_Click()
Dim sfAs String
If (Trim(TextBox1.Text) = "") Then
GoTo fin
End If
If MsgBox("Уверены?", vbYesNo, "Запрос на удаление файла") = vbYes Then
sf = Trim(TextBox1.Text)
If Dir(sf) <> "" Then
MsgBox ("File found.")
If DeleteFile(sf) Then
MsgBox "Файл удален в корзину"
ListBox1.Clear
Call CommandButton8_Click
Call CommandButton2_Click
Else
MsgBox "Не могу удалить файл через API"
Killsf
MsgBox "Файл удален командой Kill"
ListBox1.Clear
Call CommandButton8_Click
Call CommandButton2_Click
End If
Else
MsgBox ("File not found.")
End If
End If
fin:
End Sub