2015-03-23 7 views
1

У меня есть серия макросов, которые мне нужно, чтобы иметь возможность распространять мою команду для использования в нескольких разных книгах. Раньше я вручную «устанавливал» макросы для людей в их личную комнату рабочей книги, но это заняло бы слишком много времени с количеством людей, которые используют макросы.VBA: копирование рабочего листа Макрос в личную книгу

Я хочу создать книгу, в которой есть макросы, которые я хочу скопировать в PERSONAL.XLSB, а затем нажмите кнопку, которая их копирует. (бонусные баллы для сдачи их на панели быстрого доступа в верхней части)

Пример:

У меня есть книги под названием macroCopyTestBook.xlsx, и я хочу, чтобы скопировать copyThisModule модуль в PERSONAL.XLSB. Я попытался ответить на аналогичный вопрос и использовать его для этого, но он не работает. Я получаю:

Ошибка времени выполнения 424 Объект Требуется в первой строке copyTest().

Sub copyTest() 
If (CopyModule("copyThisModule", macroCopyTestBook.xlsx.VBProject, PERSONAL.XLSB, False)) Then 
    MsgBox "Copy went!" 
Else 
    MsgBox "Copy failed!" 
End If 

End Sub 

Function CopyModule(ModuleName As String, _ 
       FromVBProject As VBIDE.VBProject, _ 
       ToVBProject As VBIDE.VBProject, _ 
       OverwriteExisting As Boolean) As Boolean 

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
' CopyModule 
' This function copies a module from one VBProject to another. 
'It returns True if successful or False if an error occurs. 
' ' Parameters: ' -------------------------------- 
' FromVBProject The VBProject that contains the module to be copied. ' 
' ToVBProject The VBProject into which the module is ' to be copied. ' 
' ModuleName The name of the module to copy. ' 
' OverwriteExisting If True, the VBComponent named ModuleName in ToVBProject  will be removed before 
' importing the module. 
'If False and a VBComponent named ModuleName exists in ToVBProject, the code will return ' False. 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
Dim VBComp As VBIDE.VBComponent 
Dim FName As String 
Dim CompName As String 
Dim S As String 
Dim SlashPos As Long 
Dim ExtPos As Long 
Dim TempVBComp As VBIDE.VBComponent 

''''''''''''''''''''''''''''''''''''''''''''' 
' Do some housekeeping validation. 
''''''''''''''''''''''''''''''''''''''''''''' 
If FromVBProject Is Nothing Then 
    CopyModule = False 
    Exit Function 
End If 

If Trim(ModuleName) = vbNullString Then 
    CopyModule = False 
    Exit Function 
End If 

If ToVBProject Is Nothing Then 
    CopyModule = False 
    Exit Function 
End If 

If FromVBProject.Protection = vbext_pp_locked Then 
    CopyModule = False 
    Exit Function 
End If 

If ToVBProject.Protection = vbext_pp_locked Then 
    CopyModule = False 
    Exit Function 
End If 

On Error Resume Next 
Set VBComp = FromVBProject.VBComponents(ModuleName) 
If Err.Number <> 0 Then 
    CopyModule = False 
    Exit Function 
End If 

'''''''''''''''''''''''''''''''''''''''''''''''''''' 
' FName is the name of the temporary file to be 
' used in the Export/Import code. 
'''''''''''''''''''''''''''''''''''''''''''''''''''' 
FName = Environ("Temp") & "\" & ModuleName & ".bas" 
If OverwriteExisting = True Then 
    '''''''''''''''''''''''''''''''''''''' 
    ' If OverwriteExisting is True, Kill 
    ' the existing temp file and remove 
    ' the existing VBComponent from the 
    ' ToVBProject. 
    '''''''''''''''''''''''''''''''''''''' 
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then 
     Err.Clear 
     Kill FName 
     If Err.Number <> 0 Then 
      CopyModule = False 
      Exit Function 
     End If 
    End If 
    With ToVBProject.VBComponents 
     .Remove .Item(ModuleName) 
    End With 
Else 
    ''''''''''''''''''''''''''''''''''''''''' 
    ' OverwriteExisting is False. If there is 
    ' already a VBComponent named ModuleName, 
    ' exit with a return code of False. 
    '''''''''''''''''''''''''''''''''''''''''' 
    Err.Clear 
    Set VBComp = ToVBProject.VBComponents(ModuleName) 
    If Err.Number <> 0 Then 
     If Err.Number = 9 Then 
      ' module doesn't exist. ignore error. 
     Else 
      ' other error. get out with return value of False 
      CopyModule = False 
      Exit Function 
     End If 
    End If 
End If 

'''''''''''''''''''''''''''''''''''''''''''''''''''' 
' Do the Export and Import operation using FName 
' and then Kill FName. 
'''''''''''''''''''''''''''''''''''''''''''''''''''' 
FromVBProject.VBComponents(ModuleName).Export Filename:=FName 

''''''''''''''''''''''''''''''''''''' 
' Extract the module name from the 
' export file name. 
''''''''''''''''''''''''''''''''''''' 
SlashPos = InStrRev(FName, "\") 
ExtPos = InStrRev(FName, ".") 
CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1) 

'''''''''''''''''''''''''''''''''''''''''''''' 
' Document modules (SheetX and ThisWorkbook) 
' cannot be removed. So, if we are working with 
' a document object, delete all code in that 
' component and add the lines of FName 
' back in to the module. 
'''''''''''''''''''''''''''''''''''''''''''''' 
Set VBComp = Nothing 
Set VBComp = ToVBProject.VBComponents(CompName) 

If VBComp Is Nothing Then 
    ToVBProject.VBComponents.Import Filename:=FName 
Else 
    If VBComp.Type = vbext_ct_Document Then 
     ' VBComp is destination module 
     Set TempVBComp = ToVBProject.VBComponents.Import(FName) 
     ' TempVBComp is source module 
     With VBComp.CodeModule 
      .DeleteLines 1, .CountOfLines 
      S = TempVBComp.CodeModule.Lines(1,   TempVBComp.CodeModule.CountOfLines) 
      .InsertLines 1, S 
     End With 
     On Error GoTo 0 
     ToVBProject.VBComponents.Remove TempVBComp 
    End If 
End If 
Kill FName 
CopyModule = True 

End Function 
+0

Рассматривали ли вы создание надстройки, содержащей все функции вашей личной книги? – Kyle

+0

Если вы предоставляете свой код, мы можем помочь вам выяснить, где вы поступили неправильно. – FreeMan

+0

Что именно не работает? –

ответ

1

macroCopyTestBook.xlsx должен быть Workbooks("macroCopyTestBook").VBProject
и
PERSONAL.XLSB должны быть Workbooks("PERSONAL.XLSB").VBProject


Так что ваша функция должна выглядеть примерно так:

CopyModule("copyThisModule", Workbooks("macroCopyTestBook.xlsx").VBProject, Workbooks("PERSONAL.XLSB").VBProject, False) 

Вы не можете ссылаться на объект рабочей книги непосредственно с его имени, поэтому вам нужно использовать метод Workbooks(), чтобы VBA мог знать, что вы имеете в виду.

+0

ok, теперь это дает мне ошибку времени выполнения «1004»: Programmatic в соответствии с Visual Basic Project не доверяется – Lannister

+1

Перейдите в раздел «Файл» -> «Параметры» -> «Центр доверия» -> «Настройки центра доверия» -> «Параметры макроса» и отметьте поле, «Доверяйте доступ к объектной модели проекта VBA» –

+0

Я бы посоветовал только оставить эту опцию галочкой, пока вы запускаете этот код ... –

0

Вы также можете использовать встроенный инструмент Application.OrganizerCopy. Извините, это только в Word ..

Смежные вопросы