создание инсталяшника для написанного макроса(проги)

[nlk]

Всем привет, столкнулся с такой проблемой, можно ли для написанного макроса сделать инсталяху?? Чтобы можно было использовать прогу на др. компах. Знаю что можно переносить макрос из документа в документ, но хотелось бы сделать инсталяшник.exe. Кто знает как такое можно реализовать?

[Skif-F]

А зачем .exe?
Можно сделать тот же документ с макросами, который при запуске будет себя копировать в каталог Word'а и подключать как надстройку или шаблон.

[nlk]

Сообщение от Skif-F

А зачем .exe?
Можно сделать тот же документ с макросами, который при запуске будет себя копировать в каталог Word'а и подключать как надстройку или шаблон.

Skif-F можешь рассказать как это сделать можно?

[Skif-F]

Подскажу, но на примере Excel, поскольку для Word'а я такого ещё не делал, хотя отличия будут не принципиальные.

Private Const ThisName = "НадстройкиExcel.xlam"
Private Sub Workbook_Open()
    Application.ScreenUpdating = false
    Install     'Устанавливаем надстройку
    Application.ScreenUpdating = True
End Sub
Private Sub Install()   'Устанавливаем надстройку
    Dim ad As AddIn, UserLibraryPath As String, TWB As Workbook
    Dim MBR As VbMsgBoxResult, fso, Flag As Boolean, WB As Workbook
    
    Set fso = CreateObject("Scripting.FileSystemObject")  'Объект для работы с файлами

    Set TWB = ThisWorkbook
    Flag = False
    For Each ad In Application.AddIns   'Перебираем надстройки
        If ad.Name = ThisName Then      'Если имя надстройки совпадает с нашим
            If ad.FullName = TWB.FullName Then Exit Sub 'Проверяем, "не мы ли это"
            'Если не мы, то советуемся с пользователем:
            MBR = MsgBox("Надстройка " + ThisName + " существует, но отключена. Заменить?", vbYesNo, "Внимание!")
            If MBR = vbNo Then Exit Sub 'Если заменять не надо
            ad.Installed = False        'Отключаем
            Flag = True                 'Сигналим, что такая надстройка была
            On Error Resume Next
                Kill ad.FullName            'Удаляем файл
            On Error GoTo 0
            Exit For
        End If
    Next ad
    UserLibraryPath = Application.AddIns.Parent.UserLibraryPath 'Путь до надстроек
    fso.CopyFile TWB.FullName, UserLibraryPath + ThisName, True 'Копируем свой файл
    Set WB = Workbooks.Add  'Без этой команды надстройку не подключишь. Просто добавляем пустую книгу
    If Not Flag Then
        Set ad = AddIns.Add(FileName:=UserLibraryPath & ThisName, CopyFile:=True) 'Если такой надстройки не было, подключаем её
    End If
    ad.Installed = True         'Включаем свою надстройку
    WB.Close False
    Workbooks(ThisName).Save
    MsgBox "Закройте и опять запустите Excel"
End Sub

[nlk]

Спасибо большое

[Ципихович Эндрю]

ТС, Вы если для Ворда переделаете, пжл выложите

[Skif-F]

Если не ошибаюсь, то переделок всего-то заменить слово "Workbook" на "Document" и, по-моему, всё должно работать.

[nlk]

Слушай, а как это работает? просто эту процедуру скопировать в файл с моей прогой, сохрнить, запустить этот файл на др компе и все?

[Skif-F]

Да, файл копируется в папки Word'a (в моём случае Excel'я), подключается как надстройка и при последующих запусках Word'а запускается автоматически.

[Skif-F]

Примерно так. Только когда всё подготовите лучше пересохранить файл как "Шаблон Word с поддержкой макросов .dotm" - у меня без этого файлы из папки Startup автоматически не запускаются.

Option Explicit
Private Const ThisName = "Надстройки.dotm"

Private Sub Document_Open()
    Install     'Устанавливаем надстройку
End Sub
Private Sub Install()   'Устанавливаем надстройку
    Dim ad As AddIn, UserLibraryPath As String, TD As Document
    Dim MBR As VbMsgBoxResult, fso, Flag As Boolean, D As Document, FullName As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")  'Объект для работы с файлами

    Set TD = ThisDocument
    Flag = False
    For Each ad In Application.AddIns   'Перебираем надстройки
        FullName = ad.Path & "\" & ad.Name
        If ad.Name = ThisName Then      'Если имя надстройки совпадает с нашим
            If FullName = TD.FullName Then Exit Sub 'Проверяем, "не мы ли это"
            'Если не мы, то советуемся с пользователем:
            MBR = MsgBox("Надстройка " + ThisName + " существует, но отключена. Заменить?", vbYesNo, "Внимание!")
            If MBR = vbNo Then Exit Sub 'Если заменять не надо
            On Error Resume Next
                ad.Installed = False        'Отключаем
                ad.Delete
                Flag = True                 'Сигналим, что такая надстройка была
                Kill FullName            'Удаляем файл
            On Error GoTo 0
            Exit For
        End If
    Next ad
    UserLibraryPath = Application.StartupPath  'Путь до надстроек
    fso.CopyFile TD.FullName, UserLibraryPath & "\" & ThisName, True 'Копируем свой файл
    Set D = Documents.Add  'Без этой команды надстройку не подключишь
    If Not Flag Then
        Set ad = AddIns.Add(FileName:=UserLibraryPath & "\" & ThisName, Install:=True)  'Если такой надстройки не было, подключаем её
    End If
    ad.Installed = True         'Включаем свою надстройку
    D.Close False
    MsgBox "Закройте и опять запустите Word"
End Sub