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

Автосохранение надстройки в папке Addins

В некоторых случаях, при запуске файла Excel с макросами (к примеру, надстройки Excel), для обеспечения работы макросов требуется, чтобы был полный доступ к файлу (а не "только чтение"), или же файл был сохранён в заданной папке.

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

В этом вам поможет макрос SaveAddinToPermanentPath, который проверяет, из какой папки запущен файл, и предлагает, в случае необходимости, переместить файл в постоянную папку

В качестве постоянной папки макрос использует папку «UserLibrary», путь к которой можно получить из свойства Application.UserLibraryPath

На моём компьютере, эта папка расположена по пути 
C:\Documents and Settings\<имя пользователя>\Application Data\Microsoft\AddIns\

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

Выбор уникальных (неповторяющихся) значений из списка в виде текстовой строки

Function JustUnique(ByVal txt As String, Optional ByVal Separator As String = ", ") As String
    ' Принимает в качестве параметра обрабатываемую строку txt,
    ' и разделитель Separator элементов строки txt.
    ' Возвращает строку txt, но уже не содержающую повторяющихся значений
    Dim coll As New Collection: On Error Resume Next
    For Each v In Split(txt, Separator)
        coll.Add CStr(v), CStr(v)
    Next v
    For Each v In coll: JustUnique = JustUnique & Separator & v: Next v
    JustUnique = Mid(JustUnique, Len(Separator) + 1)
End Function
 
 
Sub ПримерИспользования_ВыборУникальныхЗначенийИзСписка()
    txt = "58, 28, 32, 60, 28, 58, 14"
    new_txt = JustUnique(txt) ' возвращает строку "58, 28, 32, 60, 14"
    Debug.Print "Уникальные значения: " & new_txt, vbInformation, "Исходная строка: " & txt
End Sub