Программно извлеките макрос (VBA) код из документов Word 2007

Похоже, есть некоторые ошибки при копировании вашего кода на вопрос.

Но я подозреваю, что есть известная проблема с индексированием:

In [73]: a=np.zeros((2,3,4)); b=np.ones((3,4)); I=np.array([0,1])

Сделайте I 2 элемента. Индексирование b дает ожидаемую форму (3,2). 3 строки из среза, 2 столбца из I индексирования

In [74]: b[:,I].shape
Out[74]: (3, 2)

Но с 3d a мы получаем транспонирование.

In [75]: a[0,:,I].shape
Out[75]: (2, 3)

и присвоение приведет к ошибке

In [76]: b[:,I]=a[0,:,I]
...
ValueError: array is not broadcastable to correct shape

Сначала помещается 2-элементный размер, определенный с помощью I, и 3 элемента из : в секунду. Это случай смешанной передовой индексации, о которой говорилось ранее, и есть проблема с ошибкой.

Вероятно, вы используете новый numpy (или scipy) и получаете другое сообщение об ошибке.

индексирование с двумя массивами или списками и срез в середине, помещает срез в конец, например

In [86]: a[[[0],[0],[1],[1]],:,[0,1]].shape
Out[86]: (4, 2, 3)

То же самое происходит с a[0,:,[0,1]]. Но есть хороший аргумент, что это не должно быть так.

Что касается исправления, вы можете перенести значение или изменить индексирование

In [88]: b[:,I]=a[0:1,:,I]

In [90]: b[:,I]=a[0,:,I].T

In [91]: b
Out[91]: 
array([[ 0.,  0.,  1.,  1.],
       [ 0.,  0.,  1.,  1.],
       [ 0.,  0.,  1.,  1.]])

In [92]: b[:,I]=a[0][:,I]

https : //github.com/numpy/numpy/issues/7030

https://github.com/numpy/numpy/pull/6256

15
задан Community 23 May 2017 в 12:32
поделиться

2 ответа

Необходимо будет добавить ссылку на Microsoft Visual Basic для Расширяемости Приложений 5.3 (или безотносительно версии, которую Вы имеете). У меня есть SDK VBA и такой на моем поле - таким образом, это не может быть точно, с чем поставлется офис.

Также необходимо включить доступ к Объектной модели VBA конкретно - посмотрите "Доверительный Центр" в опциях Word. Это в дополнение ко всем другим настройкам Office Безопасности макросов, обеспечивает.

Этот пример извлечет код из текущего документа, в котором он живет - это само - макрос VBA (и отобразит себя и любой другой код также). Существует также Application.vbe. Набор VBProjects для доступа к другим документам. В то время как я никогда не делал этого, я предполагаю, что внешнее приложение могло добраться для открытия файлов с помощью этого набора VBProjects также. Безопасность забавна с этим материалом, таким образом, это может быть хитро.

я также задаюсь вопросом, что docm формат файла теперь - XML как docx? Это было бы лучшим подходом?

Sub GetCode()

    Dim prj As VBProject
    Dim comp As VBComponent
    Dim code As CodeModule
    Dim composedFile As String
    Dim i As Integer

    Set prj = ThisDocument.VBProject
        For Each comp In prj.VBComponents
            Set code = comp.CodeModule

            composedFile = comp.Name & vbNewLine

            For i = 1 To code.CountOfLines
                composedFile = composedFile & code.Lines(i, 1) & vbNewLine
            Next

            MsgBox composedFile
        Next

End Sub
9
ответ дан 1 December 2019 в 01:24
поделиться

Вы могли экспортировать код в файлы и затем считать их, въезжают задним ходом.

я использовал код ниже, чтобы помочь мне сохранить некоторые макросы Excel при управлении исходным кодом (использующий Подверсию & TortoiseSVN). Это в основном экспортирует весь код в текстовые файлы любое время, которое я экономлю с открытым редактором VBA. Я поместил текстовые файлы в подверсию так, чтобы я мог сделать diffs. Необходимо смочь адаптировать/украсть часть этого для работы в Word.

регистрация реестра CanAccessVBOM () соответствует, "Доверяют доступ к Проекту Visual Basic" в настройке безопасности.

Sub ExportCode()

    If Not CanAccessVBOM Then Exit Sub ' Exit if access to VB object model is not allowed
    If (ThisWorkbook.VBProject.VBE.ActiveWindow Is Nothing) Then
        Exit Sub ' Exit if VBA window is not open
    End If
    Dim comp As VBComponent
    Dim codeFolder As String

    codeFolder = CombinePaths(GetWorkbookPath, "Code")
    On Error Resume Next
    MkDir codeFolder
    On Error GoTo 0
    Dim FileName As String

    For Each comp In ThisWorkbook.VBProject.VBComponents
        Select Case comp.Type
            Case vbext_ct_ClassModule
                FileName = CombinePaths(codeFolder, comp.Name & ".cls")
                DeleteFile FileName
                comp.Export FileName
            Case vbext_ct_StdModule
                FileName = CombinePaths(codeFolder, comp.Name & ".bas")
                DeleteFile FileName
                comp.Export FileName
            Case vbext_ct_MSForm
                FileName = CombinePaths(codeFolder, comp.Name & ".frm")
                DeleteFile FileName
                comp.Export FileName
            Case vbext_ct_Document
                FileName = CombinePaths(codeFolder, comp.Name & ".cls")
                DeleteFile FileName
                comp.Export FileName
        End Select
    Next

End Sub
Function CanAccessVBOM() As Boolean
    ' Check resgistry to see if we can access the VB object model
    Dim wsh As Object
    Dim str1 As String
    Dim AccessVBOM As Long

    Set wsh = CreateObject("WScript.Shell")
    str1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\" & _
        Application.Version & "\Excel\Security\AccessVBOM"
    On Error Resume Next
    AccessVBOM = wsh.RegRead(str1)
    Set wsh = Nothing
    CanAccessVBOM = (AccessVBOM = 1)
End Function


Sub DeleteFile(FileName As String)
    On Error Resume Next
    Kill FileName
End Sub

Function GetWorkbookPath() As String
    Dim fullName As String
    Dim wrkbookName As String
    Dim pos As Long

    wrkbookName = ThisWorkbook.Name
    fullName = ThisWorkbook.fullName

    pos = InStr(1, fullName, wrkbookName, vbTextCompare)

    GetWorkbookPath = Left$(fullName, pos - 1)
End Function

Function CombinePaths(ByVal Path1 As String, ByVal Path2 As String) As String
    If Not EndsWith(Path1, "\") Then
        Path1 = Path1 & "\"
    End If
    CombinePaths = Path1 & Path2
End Function

Function EndsWith(ByVal InString As String, ByVal TestString As String) As Boolean
    EndsWith = (Right$(InString, Len(TestString)) = TestString)
End Function
27
ответ дан 1 December 2019 в 01:24
поделиться
Другие вопросы по тегам:

Похожие вопросы: