VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "API_UserInteraction" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = False Attribute VB_Exposed = False '================ Класс инкапсуляции взаимодействия с пользователем ========================= ' Shared module version: 20220611 ' Depends on: ' Required reference: Option Explicit Public Function ShowMessage(nMsg&, ParamArray params() As Variant) Call UIShowMessage(nMsg, params) End Function Public Function AskQuestion(nQuestion&, ParamArray params() As Variant) As Boolean AskQuestion = UIAskQuestion(nQuestion, params) End Function Public Function FollowHyperlink(oDocument As Object, sAddress$) Call oDocument.FollowHyperlink(sAddress) End Function Public Function PromptInput(sPrompt$, Optional sTitle$ = vbNullString, Optional sInitial As Variant) As String PromptInput = VBA.InputBox(sPrompt, sTitle, sInitial) End Function Public Function PromptFileFilter(sInitialPath$, sDescription$, sFilter$, _ Optional sTitle$ = "Выберите файл", _ Optional bNewApplication As Boolean = False) As String Dim cFilters As New Collection Dim cDescriptions As New Collection Call cFilters.Add("*.*") Call cDescriptions.Add("Все файлы") Call cFilters.Add(sFilter) Call cDescriptions.Add(sDescription) PromptFileFilter = PromptFile(sInitialPath, sTitle, cDescriptions, cFilters, bNewApplication) End Function Public Function PromptFile(sInitialPath$, _ Optional sTitle$ = "Выберите файл", _ Optional cDescriptions As Collection = Nothing, _ Optional cFilters As Collection = Nothing, _ Optional bNewApplication As Boolean = False) As String PromptFile = vbNullString Dim oApplication As Object If Not bNewApplication Then Set oApplication = Application Else Set oApplication = CreateObject("Excel.Application") oApplication.Visible = True End If Dim filterCount&: filterCount = 0 If Not cDescriptions Is Nothing And Not cFilters Is Nothing Then _ If cDescriptions.Count = cFilters.Count Then _ filterCount = cFilters.Count On Error Resume Next With oApplication.FileDialog(msoFileDialogFilePicker) .InitialFileName = sInitialPath .AllowMultiSelect = False .ButtonName = "Выбрать" .Title = sTitle Call .Filters.Clear If filterCount > 0 Then Dim nItem& For nItem = 1 To filterCount Step 1 Call .Filters.Add(cDescriptions.Item(nItem), cFilters.Item(nItem), 1) Next nItem Else Call .Filters.Add("Все файлы", "*.*") End If Call .Show If .SelectedItems.Count > 0 Then _ PromptFile = .SelectedItems(1) End With If bNewApplication Then _ Call oApplication.Quit End Function Public Function PromptFolder(sInitialPath$, _ Optional sTitle$ = "Выберите каталог", _ Optional bNewApplication As Boolean = False) As String PromptFolder = vbNullString Dim oApplication As Object If Not bNewApplication Then Set oApplication = Application Else Set oApplication = CreateObject("Excel.Application") oApplication.Visible = True End If On Error Resume Next With oApplication.FileDialog(msoFileDialogFolderPicker) .InitialFileName = sInitialPath .AllowMultiSelect = False .ButtonName = "Выбрать" .Title = sTitle Call .Show If .SelectedItems.Count > 0 Then _ PromptFolder = .SelectedItems(1) End With If bNewApplication Then _ Call oApplication.Quit End Function