Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | WinAPI


Rambler's Top100


Counter CO.KZ


Комментарий : Все приведённые примеры актуальны только для 32-bit. Обладателям же 64-bit, необходимо изменить об'явления WinAPI функций. Сделать это поможет статья, опубликованная на официальном сайте Microsoft Совместимость 32- и 64-разрядных версий Office 2010 и файл Win32API_PtrSafe.txt, который можно скачать там же.



    [0] [1] [2] [3]

  1. Как программно очистить буфер обмена (WinAPI) ? 08.09.2007
  2. Как получить список файлов/папок из буфера обмена и создать гиперссылки ? NEW 29.07.2016
  3. Как определить сколько милисекунд прошло с момента запуска Microsoft Windows ? 15.08.2007
  4. Как определить сколько милисекунд прошло во время выполнения макроса ? 02.02.2008
  5. Как определить цвет пиксела Image, например, после клика ? 16.02.2012
  6. Как определить разрешение экрана ? 06.08.2007
  7. Как определить координаты курсора мышки ? 29.07.2007
  8. Как программно задать новые координаты для курсора мышки, т.е. переместить курсор к нужной точке ? 29.07.2007
  9. Как во время выполнения макроса, изменить курсор мышки на анимационный(живой) ? 20.10.2007
  10. Как определить над какой из ячеек рабочего листа находится курсор мышки ? 29.07.2007
  11. Как скрыть/отобразить курсор мышки ? 01.05.2009
  12. Как после клика правой кнопкой мышки, над определёнными ячейками, отобразить нужную панель инструментов, причём с учётом координат ? 10.05.2010
  13. Как получить абсолютную гиперссылку из относительной ? 13.04.2012
  14. Как программно создать относительную гиперссылку ? 13.04.2012
  15. Как проверить можно ли использовать текст как адрес гиперссылки ? NEW 16.07.2016
  16. Как сохранить файл из интернета, указав вручную местосохранение файла ? 24.06.2014
  17. Как используя функции WinAPI приостановить выполнение программы на определённое время ? 29.07.2007
  18. Как заблокировать ввод данных с клавиатуры, а также использование мышки (WinAPI) ? 15.09.2007
  19. Как определить является ли указанная буква прописной [ВЕРХНИЙ РЕГИСТР] (WinAPI) ? 08.09.2007
  20. Как определить является ли указанная буква строчной [нижний регистр] (WinAPI) ? 08.09.2007
  21. Как определить является ли указанный символ буквой (WinAPI) ? 08.09.2007
  22. Как удалить из начала и конца строки ненужные символы ? 27.06.2014
  23. Как быстро отсортировать массив ? 06.12.2014
    [0] [1] [2] [3]


  • Ответ :
  • Private Declare Function CountClipboardFormats Lib "user32.dll" () As Long
    Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
    Private Declare Function CloseClipboard Lib "user32.dll" () As Long

    Private Sub WinAPI_EmptyClipboard()
        If CountClipboardFormats > 0 Then
           OpenClipboard 0&: EmptyClipboard: CloseClipboard
        Else
           MsgBox "Буфер обмена не содержит данных", vbInformation, ""
        End If
    End Sub
    Комментарий : Данный способ неактуален для применения в MS Excel 2000, XP по причине появления в этих версиях буфера обмена. Впрочем в 2000 версии можно очистить и собственный буфер обмена [FAQ96]
  • Ответ :

    Для того, чтобы получить перечень всех файлов/папок из буфера обмена и создать гиперссылки, которые будут ссылаться на эти файлы, можно использовать нижеприведённый макрос. Разумеется, Вам необходимо указать свой незащищённый рабочий лист, а также столбец, ячейки которого, также не должны быть защищены.

    Обратите внимание на то, что здесь создаётся список уникальных(неповторяющихся) гиперссылок и если Вас это не устраивает, то просто уберите проверку, где используется поиск (метод .Find)
  • 'Источник
    'Название статьи : Получить список файлов из Clipboard
    'URL ссылка : http://forum.sources.ru/index.php?showtopic=98290

    Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function CloseClipboard Lib "user32.dll" () As Long
    Private Declare Function DragQueryFile _
            Lib "shell32.dll" Alias "DragQueryFileA" ( _
            ByVal HDROP As Long, _
            ByVal UINT As Long, _
            ByVal lpStr As String, _
            ByVal ch As Long) As Long

    Private Sub CreateHyperlinksFilesOfClipbord()
        Dim ihDrop As Long, iCount As Long
        Dim iList As Worksheet, iRow As Long
        Dim iFileName As String, tmp As String * 255

        If IsClipboardFormatAvailable(15&) = 0 Then Exit Sub
        If OpenClipboard(0&) = 0 Then Exit Sub

        ihDrop = GetClipboardData(15&)
        iCount = DragQueryFile(ihDrop, -1, vbNullString, 0)

        If iCount = -1 Then Exit Sub

        Set iList = ThisWorkbook.Worksheets(1) 'Укажите свой рабочий лист
        iRow = iList.Cells(iList.Rows.Count, 1).End(xlUp).Row + 1

        For iCount = 0 To iCount - 1
            DragQueryFile ihDrop, iCount, tmp, 255&
            iFileName = Application.Clean(tmp)
            If iList.Columns(1).Find(iFileName, , xlValues, xlWhole) Is Nothing Then
            'If Application.CountIf(iList.Columns(1), iFileName) = 0 Then
               iList.Hyperlinks.Add iList.Cells(iRow, 1), iFileName
               iRow = iRow + 1
            End If
        Next
        CloseClipboard
    End Sub
    Комментарий : При любом использовании материала, ссылка на первоисточник обязательна.
  • Ответ :

    Для того, чтобы определить сколько милисекунд прошло с момента запуска Windows, достаточно воспользоваться нижеприведённой функцией WinAPI
  • Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

    Private Sub GetMilliSeconds()
        MsgBox "С момента запуска Windows прошло : " & _
        GetTickCount & " милисекунд", , ""
    End Sub
    Данная функция может быть полезна, например, при точном определении времени выполнения макроса, т.е. в тех случаях, когда округление до секунды, нежелательно.

    Если Вы хотите вызвать эту функцию из ячеек рабочего листа, то в MS Excel 97 для этого можно использовать, например, функцию рабочего листа =ВЫЗВАТЬ()
    В следующих же версиях, вызов этой функции из ячеек листа заблокирован разработчиками, поэтому, Вам, по всей видимости, придётся воспользоваться пользовательской функцией, например =GetTickMilliSecond()
    Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

    Function GetTickMilliSecond&()
        Application.Volatile True
        GetTickMilliSecond& = GetTickCount
    End Function

  • Ответ :

    Для того, чтобы определить сколько милисекунд выполнялся необходимый макрос, достаточно воспользоваться нижеприведённой функцией WinAPI
  • Private Declare Function GetTickCount Lib "kernel32.dll" () As Long

    Private Sub YourMacro()
        iMlSeconds& = GetTickCount

        'Здесь должен быть код Вашей программы.

        MsgBox "Время выполнения макроса составило " & _
        GetTickCount - iMlSeconds& & " милисек.", vbExclamation, ""
    End Sub

  • Ответ : Скачать пример

    Для того, чтобы определить цвет пиксела (RGB) в указанной точке Image, можно использовать нижеприведённые функции WinAPI и событие Image1_Click()

    Для демонстрации данного примера, создайте два элемента управления Image (Рисунок), затем, используя свойство Picture, загрузите графическое изображение в Image1, и после вывода формы на экран, кликните необходимую(ые) точку(и) на Image1.
  • Private Type POINTAPI
        X As Long
        Y As Long
    End Type

    Private Declare Function FindWindow _
            Lib "user32.dll" Alias "FindWindowA" ( _
            ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long
    Private Declare Function GetDC _
            Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function GetCursorPos _
            Lib "user32.dll" (lpPoint As POINTAPI) As Long
    Private Declare Function ScreenToClient _
            Lib "user32.dll" ( _
            ByVal hWnd As Long, _
            lpPoint As POINTAPI) As Long
    Private Declare Function GetPixel _
            Lib "gdi32.dll" ( _
            ByVal hDC As Long, _
            ByVal X As Long, _
            ByVal Y As Long) As Long
    Private Declare Function SetPixel _
            Lib "gdi32.dll" ( _
            ByVal hDC As Long, _
            ByVal X As Long, _
            ByVal Y As Long, _
            ByVal crColor As Long) As Long
    Private Declare Function SetPixelV _
            Lib "gdi32.dll" ( _
            ByVal hDC As Long, _
            ByVal X As Long, _
            ByVal Y As Long, _
            ByVal crColor As Long) As Long

    Private ihWnd As Long, ihDC As Long, iPOINT As POINTAPI

    Private Sub UserForm_Initialize()
        ihWnd = FindWindow(vbNullString, Me.Caption)
        ihDC = GetDC(ihWnd)
    End Sub

    Private Sub Image1_Click()
        Dim iColorPixel As Long

        GetCursorPos iPOINT
        ScreenToClient ihWnd, iPOINT
        iColorPixel = GetPixel(ihDC, iPOINT.X, iPOINT.Y)

        Image2.BackColor = iColorPixel 'для наглядности

        'SetPixel ihDC, iPOINT.X, iPOINT.Y, vbRed 'изменить цвет
    End Sub

  • Ответ :
  • Private Declare Function GetSystemMetrics _
            Lib "user32.dll" (ByVal nIndex As Long) As Long

    Private Sub GetSystemScreen()
        Dim iX As Long, iY As Long

        iX = GetSystemMetrics(1&)
        iY = GetSystemMetrics(0&)

        MsgBox "Ваш экран имеет разрешение : " & _
        iX & "x" & iY, vbExclamation, "Информация"
    End Sub

  • Ответ :
  • Private Type POINTAPI
        X As Long
        Y As Long
    End Type

    Private Declare Function GetCursorPos _
            Lib "user32.dll" (lpPoint As POINTAPI) As Long

    Private Sub GetCursorPosition()
        Dim iPOINT As POINTAPI

        GetCursorPos iPOINT

        MsgBox "X : " & iPOINT.X & vbNewLine & "Y : " & iPOINT.Y, _
        vbExclamation, "Координаты курсора мышки"
    End Sub

  • Ответ :
  • Private Declare Function SetCursorPos _
            Lib "user32.dll" ( _
            ByVal X As Long, _
            ByVal Y As Long) As Long

    Private Sub SetCursorPosition()
        SetCursorPos 100&, 500&
    End Sub

  • Ответ : Скачать пример

    Если время выполнения Вашего макроса составляет более пяти-десяти секунд, то скрасить "часы" ожидания можно, если всё это время на экране будет маячить анимационный (живой) курсор мышки.
  • Private Declare Function LoadCursorFromFile _
            Lib "user32.dll" Alias "LoadCursorFromFileA" ( _
            ByVal lpFileName As String) As Long
    Private Declare Function SetCursor _
            Lib "user32.dll" ( _
            ByVal hCursor As Long) As Long

    Private Sub SetAniCursor()
        iFileName$ = "C:\WINDOWS\CURSORS\HOURGLAS.ANI"
        'Укажите необходимый "живой" указатель для создания курсора

        ihCurcor& = LoadCursorFromFile(iFileName$)
        SetCursor ihCurcor&

        'Здесь должен быть код Вашей программы.
    End Sub

  • Ответ : Актуально только для MS Excel 2000 и старше
  • Private Type POINTAPI
        X As Long
        Y As Long
    End Type

    Private Declare Function GetCursorPos _
            Lib "user32.dll" (lpPoint As POINTAPI) As Long

    Private Sub GetRangeFromPoint()
        Dim iPOINT As POINTAPI, iCell As Range

        GetCursorPos iPOINT

        Set iCell = ActiveWindow.RangeFromPoint(X:=iPOINT.X, Y:=iPOINT.Y)

        If Not iCell Is Nothing Then
           MsgBox "Курсор мышки находится над " & _
           iCell.Address(External:=True), vbExclamation, ""
        Else
           MsgBox "Курсор мышки находится вне ячеек рабочего листа", , ""
        End If
    End Sub

  • Ответ :

    Для того, чтобы скрыть курсор мышки, достаточно выполнить первую инструкцию, а для того, чтобы отобразить, вторую инструкцию.
  • Private Declare Function ShowCursor Lib "user32.dll" (ByVal bShow As Long) As Long

    Private Sub WinAPI_HiddenCursor()
        ShowCursor 0& '[1]
        'Здесь должен быть код Вашей программы.
        ShowCursor 1& '[2]
    End Sub

  • Ответ :

    Для того, чтобы после клика правой кнопкой мышки, над определёнными ячейками рабочего листа, отобразить нужную панель инструментов, причём с учётом координат, а стандартное контекстное меню "Ячейка" заблокировать, достаточно воспользоваться событием Worksheet_BeforeRightClick
  • Private Type POINTAPI
        X As Long
        Y As Long
    End Type
    
    Private Declare Function GetCursorPos _
            Lib "user32.dll" (lpPoint As POINTAPI) As Long
    
    Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
        If Not Intersect(Target, Me.[A1:C10]) Is Nothing Then
           Dim iPOINT As POINTAPI
           GetCursorPos iPOINT
           With Application.CommandBars("Fill Color")
                .Left = iPOINT.X
                .Top = iPOINT.Y
                .Visible = True
           End With
           Cancel = True
        End If
    End Sub
    Если речь идёт о контекстном меню, в т.ч. и созданным с помощью VBA, то вместо вышеприведённых свойств используйте метод ShowPopup
    Application.CommandBars("Workbook Tabs").ShowPopup X:=iPOINT.X, Y:=iPOINT.Y
    Примечание : Естественно, что диапазон ячеек [A1:C10] и панель инструментов "Цвет заливки" используются исключительно в качестве примера.
  • Ответ :

    Для того, чтобы перебрать все гиперссылки, расположенные в столбце "A" активного рабочего листа и получить абсолютный путь из относительного, можно воспользоваться нижеприведённым макросом. Обратите внимание на то, что лист, диапазон(столбец), а также функция MsgBox используются исключительно в качестве примера.
  • Private Declare Function PathIsRelative _
            Lib "shlwapi.dll" Alias "PathIsRelativeA" ( _
            ByVal pszPath As String) As Long
    Private Declare Function GetFullPathName _
            Lib "kernel32.dll" Alias "GetFullPathNameA" ( _
            ByVal lpFileName As String, _
            ByVal nBufferLength As Long, _
            ByVal lpBuffer As String, _
            ByVal lpFilePart As String) As Long
    
    Private Sub getAbsoluteHyperlink()
        Dim iHyperlink As Hyperlink
        Dim iPath$, iAddress$, iAbsoluteName$
    
        iPath = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base")
        If iPath = "" Then ThisWorkbook.Path
        If Not iPath Like "*\" Then iPath = iPath & "\"
       
        For Each iHyperlink In Range("A:A").Hyperlinks
            iAddress = iHyperlink.Address
            If CBool(PathIsRelative(iAddress)) = True Then
               iAbsoluteName = Space(255)
               GetFullPathName _
               iPath & iAddress, 255&, iAbsoluteName, vbNullString
               iAbsoluteName = RTrim(iAbsoluteName)
               'iAbsoluteName = Application.Clean(iAbsoluteName)
               
               MsgBox _
               "Относительная = " & iAddress & vbCr & _
               "Абсолютная = " & iAbsoluteName, , iHyperlink.Range.Address
            Else
               MsgBox "Абсолютная = " & iAddress, , iHyperlink.Range.Address
            End If
        Next
    End Sub
    Private Sub getAbsoluteHyperlink2()
        Dim iSource As Range, iHyperlink As Hyperlink
        Dim iPath$, iAddress$, iAbsoluteName$, iLength&
    
        iPath = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base")
        If iPath <> "" Then
           If Right(iPath, 1) <> "\" Then iPath = iPath & "\"       
        Else
           iPath = ThisWorkbook.Path & "\"
        End If    
        Set iSource = ThisProject.Лист1.Columns(1)
       
        For Each iHyperlink In iSource.Hyperlinks
            iAddress = iHyperlink.Address
            If PathIsRelative(iAddress) = 1 Then
               iAbsoluteName = Space(255)
               iLength = GetFullPathName( _
               iPath & iAddress, 255&, iAbsoluteName, vbNullString)
               iAbsoluteName = Left(iAbsoluteName, iLength)
               
               MsgBox _
               "Относительная = " & iAddress & vbCr & _
               "Абсолютная = " & iAbsoluteName, , ""
            Else
               MsgBox "Абсолютная = " & iAddress, , ""
            End If
        Next
    End Sub
    Примечание : Используемые в данном макросе функции WinAPI не проверяют ни корректность адреса гиперссылки, ни наличие файлов(папок), так что будьте внимательны.
  • Ответ : Скачать пример

    Для того, чтобы с помощью VBA создать относительную гиперссылку file:// , т.е. гиперссылку, адрес которой будет определяться относительно базового адреса (меню Файл команда Свойства закладка Документ и поле База гиперссылки) или, в случае отсутствия базы гиперссылки, папки, в которой находится текущая книга (разумеется, книга с макросом, предварительно должна быть сохранена) можно использовать нижеопубликованный макрос CreateRelativeHyperlink. Обратите внимание на то, что активный лист, ячейка "A1", диалоговое окно выбора файла и т.п., используются исключительно в качестве примера.
  • Private Declare Function PathRelativePathTo _
            Lib "shlwapi.dll" Alias "PathRelativePathToA" ( _
            ByVal pszPath As String, _
            ByVal pszFrom As String, _
            ByVal dwAttrFrom As Long, _
            ByVal pszTo As String, _
            ByVal dwAttrTo As Long) As Long
    
    Private Sub CreateRelativeHyperlink()
        Dim iPath$, iAddress$, iFileName 'As Variant
       
        iPath = ThisWorkbook.BuiltinDocumentProperties("Hyperlink Base")
        If iPath = "" Then
           iPath = ThisWorkbook.Path
        Else
           If iPath Like "*\" Then _
           iPath = Left(iPath, Len(iPath) - 1)
        End If
    
        ChDrive Left(iPath, 3): ChDir iPath 'необязательно
    
        iFileName = Application.GetOpenFilename( _
        Title:="Выберите файл для создания гиперссылки")
        
        If iFileName <> False Then
           iAddress = Space(255)
           If CBool(PathRelativePathTo( _
              iAddress, iPath, 16&, CStr(iFileName), 0&)) = True Then
              iAddress = RTrim(iAddress) 'Application.Clean(iAddress)
           Else
              iAddress = CStr(iFileName)
           End If
           Range("A1").Clear 'Range("A1").Hyperlinks.Delete
           ActiveSheet.Hyperlinks.Add Range("A1"), iAddress
        Else
           MsgBox "Необходимо было выбрать файл", vbCritical, ""
        End If
    End Sub

  • Ответ :

    Для того, чтобы определить, допустимо ли использовать некий текст в качестве адреса при создании гиперссылки, можно проверить начинается ли он с "http:" , "ftp:" , "mailto:" , "file:" или "\\"   Но можно использовать и альтернативный вариант, а именно WinAPI функцию PathIsURL
  • Private Declare Function PathIsURL _
            Lib "shlwapi.dll" Alias "PathIsURLA" ( _
            ByVal pszPath As String) As Long
    
    Private Sub WinAPI_IsValidHyperlink()
        Dim iAddress$
        iAddress = Range("A1").Text '"http://mail.ru"
        
        If PathIsURL(iAddress) = 1 Then
           MsgBox "Можно создавать гиперссылку", , ""
        Else
           MsgBox "Не рекомендуется", vbCritical, ""
        End If
    End Sub
    Комментарий : Несмотря на то, что при создании гиперссылки вручную возможно использование такого варианта www.yahoo.com , программное же создание, без указания http:// приведёт к появлению следующего сообщения. Поэтому не удивляйтесь, если текст, где отсутствует явное указание протокола, будет признан негодным для создания гиперссылки. К сожалению, это касается и строки, типа, "C:\Мои документы" которую можно использовать в качестве адреса гиперссылки, но, повторюсь, функция PathIsURL считает иначе.
  • Ответ :

    Для того, чтобы с помощью VBA скачать файл из интернета, при этом, указав вручную папку, куда необходимо сохранить файл, а при необходимости, и новое имя файла (т.е. фактически выполнив команду Сохранить как, которая появляется в контекстном меню браузера, когда мы подводим курсор к интересующей нас ссылке и кликаем правую кнопку мышки), можно использовать следующий код, разумеется, указав свой файл.
  • Private Declare Function DoFileDownload _
            Lib "shdocvw.dll" ( _
            ByVal lpszFile As String) As Long
    
    Private Sub WinAPI_DownloadFileWEB()
        Dim iFileName$
        iFileName = "http://www.msoffice.nm.ru/faq/files/FunctionExcel.chm"
    
        DoFileDownload StrConv(iFileName, vbUnicode)
    End Sub

  • Ответ :

    Для того, чтобы приостановить выполнение программы на нужное время, можно воспользоваться нижеприведённым вариантом. Данную процедуру имеет смысл использовать в том случае, когда стандартные возможности, как-то метод Wait об'екта Application [FAQ191] не подходят, например, если время должно составлять 250 милисекунд.
  • Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

    Private Sub WinAPI_MacroWait()
        MsgBox "Первое сообщение" 'используется только для демонстрации

        Sleep 250&

        MsgBox "Второе сообщение" 'аналогично
    End Sub

  • Ответ :

    Для того, чтобы во время выполнения макроса, заблокировать ввод данных с клавиатуры, а также использование мышки, можно воспользоваться нижеприведённым вариантом. Данной функцией имеет смысл воспользоваться в том случае, когда стандартные возможности, например [FAQ72], [FAQ371] не подходят. Обратите внимание на то, что применение функции BlockInput не позволит Вам использовать диалоговые окна, в т.ч. и стандартные, а также функции MsgBox, InputBox
  • Private Declare Function BlockInput Lib "user32.dll" (ByVal fBlock As Long) As Long

    Private Sub WinAPI_EnableKeyMouse()
        BlockInput 1&
        'Здесь должен быть код Вашей программы.
        BlockInput 0&
    End Sub
    Примечание : Минимальные требования, при использовании данной функции, наличие Windows 98
  • Ответ :
  • Private Declare Function IsCharUpper _
            Lib "user32.dll" Alias "IsCharUpperA" ( _
            ByVal cChar As Byte) As Long

    Private Sub Test_IsCharUp()
        iSymbol$ = "F" '"f"

        If IsCharUpper(Asc(iSymbol$)) <> 0 Then
           MsgBox "Да", vbExclamation, ""
        Else
           MsgBox "Нет", vbExclamation, ""
        End If
    End Sub

  • Ответ :
  • Private Declare Function IsCharLower _
            Lib "user32.dll" Alias "IsCharLowerA" ( _
            ByVal cChar As Byte) As Long

    Private Sub Test_IsCharLw()
        iSymbol$ = "r" '"R"

        If IsCharLower(Asc(iSymbol$)) <> 0 Then
           MsgBox "Да", vbExclamation, ""
        Else
           MsgBox "Нет", vbExclamation, ""
        End If
    End Sub

  • Ответ :
  • Private Declare Function IsCharAlpha _
            Lib "user32.dll" Alias "IsCharAlphaA" ( _
            ByVal cChar As Byte) As Long

    Private Sub Test_IsCharAlpha()
        iText$ = "Microsoft Excel - это [...]"

        For iCount& = 1 To Len(iText$)
            iSymbol$ = Mid(iText$, iCount&, 1)
            If IsCharAlpha(Asc(iSymbol$)) <> 0 Then
               MsgBox "Символ «" & iSymbol$ & "» это буква алфавита", , ""
            Else
               MsgBox "Символ «" & iSymbol$ & "» не является буквой", , ""
            End If
        Next
    End Sub

  • Ответ :

    Для того, чтобы из начала и конца строки удалить ненужные символы, можно использовать WinAPI функцию StrTrim, не забывая, что при удалении перечисленных символов, данная функция учитывает регистр.
  • Private Declare Function StrTrim _
            Lib "shlwapi.dll" Alias "StrTrimA" ( _
            ByVal pszText As String, _
            ByVal pszTrimText As String) As Long

    Private Sub WinAPI_StrTrim()
        Dim iText$, iTrimText$
        iText = "_!ABCDEFG#"
        iTrimText = "#A_g\0!"

        If StrTrim(iText, iTrimText) = 1 Then
           MsgBox Application.Clean(iText), , ""
        Else
           MsgBox "Замены не произошло"
        End If
    End Sub
    Если же Вам нужно "отгрызть" символы только с одной стороны, то Вы можете просто добавить к противоположной стороне какой-нибудь символ, который абсолютно точно отсутствует в перечне удаляемых. Что, собственно, и демонстрируется в нижеприведённом примере, который, кстати, легко заменяется на одну строку, где используется функция InStrRev (XL2000)
    Private Sub WinAPI_StrTrim2()
        Dim iText$, iTrimText$
        iText = "BMW-Photo.12.jpeg"
        iTrimText = "JPEGIFBMN"

        iText = "." & UCase(iText)
        If StrTrim(iText, iTrimText) = 1 Then
           iText = Mid(iText, 2, InStr(iText, vbNullChar) - 3)
           MsgBox iText
        Else
           MsgBox "Замены не произошло"
        End If
    End Sub
    Примечание : Минимальные требования, при использовании данной функции, наличие Windows 2000
  • Ответ :

    Для быстрой сортировки массива, Вы можете воспользоваться этим советом (автор Aртём Скробов он же tyomitch)
    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

  • © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff