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

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

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

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

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

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

Макрос для увеличения картинок по щелчку мыши

Макрос позволяет увеличивать / уменьшать изображения на листе Excel по щелчку мыши.

 

Для использования макроса, скопируйте в свой файл модуль с кодом (просто перетащив его мышкой из прикреплённого файла),
выделите все картинки в своём файле Excel, и назначьте им макрос ZoomImage

Чтобы выделить все изображения, проделайте следующее:

  • нажмите Ctrl + G (для появления диалогового окна «Переход»)
  • нажмите кнопку «Выделить» в этом диалогом окне
  • в появившемся окне «Выделение группы ячеек» поставьте галочку «Объекты», и нажмите OK

 

После этого (как все картинки будут выделены), щелкните на одной из картинок правой кнопкой мыши,
в контекстном меню нажмите «Назначить макрос», выделите макрос ZoomImage, и нажмите OK

 

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

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

 

Код макроса ZoomImage:

Макрос для исправления повреждённых гиперссылок во всей книге 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

Отображение кодов символов для текста выделенной ячейки

Окно вывода кодов символов для текущей ячейки

Надстройка предназначена для быстрого просмотра кодов символов текста, введённого в ячейку.

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

И вот в этих случаях на помощь приходит эта надстройка.

С её помощью вы быстро обнаружите, что в похожих ячейках одни и те же буквы набраны в разных раскладках или в разных кодировках, а также сможете отличить обычный пробел (с кодом 32) от неразрывного (с кодом 160).

Пользоваться надстройкой очень просто - выделите ячейку, содержащую анализируемый текст, и нажмите комбинацию клавиш Ctrl + Alt + Shift + C

При выделении на форме результатов позиции с кодом символа - этот символ подсвечивается (выделяется синим) в поле с содержанием текстовой строки.

Можно открыть сразу несколько окон просмотра - выделяйте различные ячейки, и для каждой из них нажимайте вышеозвученную комбинацию на клавиатуре: