VBA для копирования значений свойств из одного объекта в другой

[Exactamente]

Есть у кого-нибудь такой, поделитесь?
В частности, интересуют динамические (привязки к тегам и скриптам) и события. Для случаев, когда нужно в customized object'e что-то поменять, а таких объектов полсотни - чтобы не ручками набивать, а изменить один, наклонировать и подменить ими уже существующие с переносом их настроек. За пару дней, конечно, можно наваять, но чтоб время не терять - вдруг есть готовое? Да и не сказать, что испытываю особую любовь к VBA, даже наоборот) Кстати, VB по результатами опроса stackoverflow в этом году признан самой нелюбимой технологией)

[SaNNy]

В общем виде такого в VBA сделать не возможно, а так, проще самому скрипт набросать

[DelSnos]

Готового кода для вашей задачи нет, но есть код, который может быть вам сэкономит время. Давно это было, правда. Попробую вспомнить
Ниже код, который ищет тип объекта GroupObject, в имени которого есть "ST_AS_", далее он уже в этом GroupObject ищет объект с именем "Value", после чего копирует название тега из свойства "OutputValue в атрибут "ReplaceTagname".
Далее происходит поиск "ReplaceTagname" по Excel-документу "All_CommentsEngUnits.xlsm", если есть, то копируются оттуда ячейки, содержащие комментарий тега и ед. измерения. в определенный массив "Comment".
Далее происходит запись С-скрипта по mouse action этого GroupObject . Текст скрипта копируется из файла "PictureTreeManager.xlsx"
c подстановкой массива "Comment" в определенное место скрипта... Как-то так.
Также код автоматически открывает и сохраняет проделанные изменения в PDL-файлы. Список PDL-файлов подсасывается из excel-документа "PictureTreeManager.xlsx".

Код: Выделить всё

Sub FindObjectsByName()
Dim fso As FileSystemObject
Dim TextStream As TextStream
Dim pStream As TextStream
Dim strCode As String
Dim FileLines() As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set TextStream = fso.OpenTextFile("D:\work\forVBA\CTrendSmallRightClick.txt", ForReading) ' в этом файле записан скрипт, который будет автоматически вставляться п.к.м по нажатию на иконку.
strCode = TextStream.ReadAll
TextStream.Close

Dim colSearchResults As HMICollection
[b]Dim objMember As HMIObject[/b]
Dim iResult As Integer
Dim strName As String
Dim objGroup As HMIGroup
Dim iMaxMembers As Integer
Dim NameGroup As String

Dim objVBScript As HMIScriptInfo
Dim ObjEvent As HMIEvent

Dim objXLS As Excel.Application
Dim objWSheet As Excel.Worksheet
Dim objWBook As Excel.Workbook
Dim objWSheet_All_comments As Excel.Worksheet
Dim objWBook_All_comments As Excel.Workbook
Dim iRow As Long
Dim iClm As Long
Dim str As String
Set objWBook = Workbooks.Open("D:\work\forVBA\PictureTreeManager.xlsx")
Set objWSheet = objWBook.Worksheets.Item("PTM")

Set objWBook_All_comments = Workbooks.Open("D:\work\forVBA\All_CommentsEngUnits.xlsm")
Set objWSheet_All_comments = objWBook_All_comments.Worksheets.Item("Лист1")

Dim strCodeReplace As String
Dim ReplaceTagname As String


For t = 1 To objWSheet.UsedRange.Rows.Count
Set PDL1 = Documents.Open(objWSheet.Cells(t, 2).value, hmiOpenDocumentTypeInvisible) 'Активация PDL-ки
[b]Set colSearchResults = PDL1.HMIObjects.Find(ObjectType:="HMIGroup", ObjectName:="*ST_AS_*")[/b]

[b]For Each objMember In colSearchResults
        iResult = colSearchResults.Count
        strName = objMember.ObjectName
        Set objGroup = PDL1.HMIObjects(strName)
        iMaxMembers = objGroup.GroupedHMIObjects.Count
          For j = 1 To iMaxMembers

                If InStr(1, objGroup.GroupedHMIObjects(j).ObjectName, "value", vbTextCompare) > 0 Then
                    If objGroup.GroupedHMIObjects(j).Properties("OutputValue").DynamicStateType > 1 Then
                            Set DynamicName = objGroup.GroupedHMIObjects(j).Properties("OutputValue").Dynamic

                            ReplaceTagname = DynamicName.SourceCode ' Если есть Dynamic соединение (DynamicStateType>1)

                        Else
                            If objGroup.GroupedHMIObjects(j).Properties("OutputValue").DynamicStateType = 0 Then
                                ReplaceTagname = "NotTag"

                                    Else
                                        ReplaceTagname = objGroup.GroupedHMIObjects(j).Properties("OutputValue").Dynamic.VarName ' Прямое соединение тега (DynamicStateType=1)[/b]
'On Error Resume Next: Err.Clear

Dim Comment
Dim pos
Dim k
Set FindText = Range("D1", Range("D" & Rows.Count).End(xlUp))   'Текст для поиска

For pos = 1 To FindText.Count
If InStr(1, Cells(pos, 4).value, ReplaceTagname, vbTextCompare) > 0 Then
Comment = ReplaceTagname + ";" + Cells(pos, 7) + ";" + Cells(pos, 6)
End If

Next

                            End If
                    End If
                End If
            Next
        Set objVBScript = objMember.Events(1).Actions.AddAction(hmiActionCreationTypeVBScript)
        objVBScript.Delete
        Set objVBScript = objMember.Events(1).Actions.AddAction(hmiActionCreationTypeCScript)
            With objVBScript
            .SourceCode = strCode
            End With
        ' Замена динамических значений уже записанного кода
        strCodeReplace = Replace(objVBScript.SourceCode, "ReplaceTagname", Comment) ' меняем имя тега
        objVBScript.SourceCode = strCodeReplace

Next objMember

ActiveDocument.Save
ActiveDocument.Close
Next
MsgBox "Готово!"
End Sub

[Exactamente]

Спасибо, но это не совсем то =( Подобный скрипт у меня есть, чтобы экспорт-импорт свойств в файл, но хочется проще и автоматизированней. В прниципе, уже почти сам написал, на неделе мб выложу, если будет время до ума довести.