Макросы VBA Excel — Страница 9

Макрос для исправления повреждённых гиперссылок во всей книге Excel

Макрос для исправление повреждённых гиперссылок во всей книге:

Sub ЗаменаИспорченныхГиперссылок()
    On Error Resume Next
    Dim hl As Hyperlink, oldString As String, newString As String, sh As Worksheet
    ' часть гиперссылки, подлежащая замене
    oldString = "C:\Documents and settings\Бухгалтер\Application data"
    ' на что заменяем
    newString = "\\адрес_сервера"
    For Each sh In ActiveWorkbook.Worksheets    ' перебираем все листы в активной книге
        For Each hl In sh.Hyperlinks    ' перебираем все гиперссылки на листе
            If hl.Address Like oldString & "*" Then
                hl.Address = Replace(hl.Address, oldString, newString)
            End If
        Next
    Next sh
End Sub
Макрос может быть полезен для замены абсолютных гиперссылок на относительные, а также помогает вернуть работоспособность ссылок после случайного сохранения файла Excel в другой папке (на другом диске).

Если нужно заменить несколько вариантов неверных ссылок, код будет таким:

Sub ЗаменаИспорченныхГиперссылок_2()
    On Error Resume Next
    Dim hl As Hyperlink, newString$, sh As Worksheet
 
    ' часть гиперссылки, подлежащая замене
    oldString1 = "C:\Documents and settings\Бухгалтер\1"
    oldString2 = "C:\Documents and settings\Бухгалтер\2"
 
    ' на что заменяем
    newString = "\\адрес_сервера"
 
    For Each sh In ActiveWorkbook.Worksheets    ' перебираем все листы в активной книге
        For Each hl In sh.Hyperlinks    ' перебираем все гиперссылки на листе
            If hl.Address Like oldString1 & "*" Then  hl.Address = Replace(hl.Address, oldString1, newString)
            If hl.Address Like oldString2 & "*" Then  hl.Address = Replace(hl.Address, oldString2, newString)            
        Next
    Next sh
 
End Sub

Расширенная версия этого макроса учитывает, что слеш в ссылках может быть как прямым, так и обратным, а также выводит информацию о количестве произведённых замен, и список ссылок из файла, которые не были обработаны (к которым замены не были применены)

Sub ЗаменаИспорченныхГиперссылок2()
    On Error Resume Next
    Dim hl As Hyperlink, oldString$, newString$, sh As Worksheet, n&, msg$, coll As New Collection, Item
 
    ' часть гиперссылки, подлежащая замене
    oldString = "../../AppData/Roaming/Microsoft/Excel/"
    ' на что заменяем
    newString = "C:\Users\Admin\Desktop\ОТЧЁТЫ ВСЕ\"
 
    For Each sh In ActiveWorkbook.Worksheets    ' перебираем все листы в активной книге
        For Each hl In sh.Hyperlinks    ' перебираем все гиперссылки на листе
            ' Debug.Print hl.Address
            If (hl.Address Like oldString & "*") Or (hl.Address Like Replace(oldString, "/", "\") & "*") Then
                hl.Address = Replace(hl.Address, oldString, newString, , , vbTextCompare)
                hl.Address = Replace(hl.Address, Replace(oldString, "/", "\"), newString, , , vbTextCompare)
                n = n + 1
            Else
                If InStr(1, hl.Address, "mailto", vbTextCompare) = 0 Then coll.Add hl.Address, UCase(hl.Address)
            End If
        Next
    Next sh
 
    For Each Item In coll
        msg$ = msg$ & Item & vbNewLine
    Next
 
    MsgBox "Заменено гиперссылок: " & n & IIf(Len(msg$), vbNewLine & vbNewLine & _
                                                         "Также в файле найдены ссылки на:" & vbNewLine & msg$, ""), vbInformation
End Sub

Транслитерация текстовой строки средствами VBA

Function Translit(ByVal txt As String) As String
 
Sub ПримерИспользованияФункцииTranslit()
    txt = "проверка работы транслита"
    newtxt = Translit(txt) ' результат = строка "proverka rabot'y translita"
    MsgBox "Строка """ & txt & """" & vbNewLine & "преобразована в строку """ _
         & newtxt & """", vbInformation, "Результат обработки"
End Sub

Автозапуск файла при открытии Excel

Сегодня мы поговорим о том, как добиться автоматического открытия вашего файла Excel (книги или надстройки) при запуске приложения Microsoft Excel

Способов добавить файл в автозагрузку Excel достаточно много, поэтому мы рассмотрим только самые основные:

  • открытие файлов из папки автозапуска
  • подключение файла как надстройки

Начнём с папки автозагрузки (точнее, с папок, поскольку их может быть несколько)

Работа с FTP из VBA

Представляю вашему вниманию инструментарий для работы с файлами по FTP

Как известно, отправить файл на FTP сервер (или загрузить файл с FTP, создать папку на FTP сервере, и т.д.) можно при помощи таких API-функций из библиотеки wininet.dll, как FtpPutFile, FtpGetFile, FtpRenameFile, FtpDeleteFile, FtpRemoveDirectory, FtpCreateDirectory, FtpFindFirstFile и т.д.

Как именно использовать эти функции - можете посмотреть в коде надстройки для отправки файлов Excel на FTP сервер

В чем недостаток этого способа - так это в необходимости обеспечения совместимости кода с различными платформами.
В частности, чтобы код с функциями API работал и в Office 2010, и в 64-битной Windows, необходимо заметно увеличить объём кода. А, поскольку описание этих функций из wininet.dll и без того занимает много места (а универсальный код вообще займёт сотню строк), да и надо ещё и разбираться во всех этих функциях, т.к. в разных версиях Windows возможны различия в способе вызова функций из wininet.dll, и были созданы аналоги этих функций для работы с FTP, не использующие WinAPI

Сподвигла меня на это решение необходимость реализации средств обновления надстроек Excel, где необходимо было реализовать функционал отправки файлов Excel на FTP сервер, причем так, чтобы это стабильно работало на всех компьютерах. Попутно, кстати, родилась и функция загрузки файла с сервера без использования WinAPI, которая тоже вошла в состав данного инструментария.

 

Основу предлагаемого мной решения составляет модуль класса FTPcommander, который предоставляет вам следующие функции:

Форма авторизации для проектов VBA

Форма авторизации предназначена для разграничения прав пользователей при работе с документами Office, содержащими макросы.

 

При помощи данного инструмента вы можете реализовать различные пользовательские интерфейсы для сотрудников различных групп доступа, а также разграничить права отдельных пользователей программы.

 

Программа допускает создание неограниченного числа пользователей, каждый из которых принадлежит к одной из следующих групп:
пользователь, уверенный пользователь, администратор, разработчик.
(количество групп при желании можно легко увеличить до 9999)