下午好
第一个问题在这里。希望有道理。
在遍历电子表格时使用单元格值动态设置类属性时遇到困难。当使用基于单元格值的Select Case（当前在下面的代码中指出）时，我可以使以下内容起作用-这不是一种动态方法。我现在正在调查是否可以使用 CallByName 动态设置媒体资源。
当我使用CallByName时，它会成功填充第一个属性（始终是Identifier）-这总是在第一次将键添加到字典时出现，但是当它循环到下一行并尝试填充下一个属性时得到消息“对象不支持此属性或方法” 。
我希望这是一个简单的解决方法，但是对于我一生来说，无论我做什么，我似乎都无法超越终点。我要尝试做的是使我拥有的应用程序正常运行，然后尝试使其变得更好，更高效。 非常感谢您的帮助。
谢谢 莱斯
错误行在此处
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' This works when the class object is first created but not when the next loop to populate the next property
' ERROR HERE........
CallByName oItem, .Value, VbLet, Trim(.Offset(0, ARISModel.COLB).Value)
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
完整子代码
Private Function GetSourceData(sFileName As String, dictARIS As Scripting.Dictionary) As Scripting.Dictionary
On Error GoTo EH
' this loops through the ARIS worksheet and extracts the data relevant to "Functions"
' It seems to start witht eh field "Identifier" and end with "Relationship Type"
' Open the source file
Dim wbk As Workbook, ws As Worksheet, coll As New Collection
' Open selected file as read only
Set wbk = Workbooks.Open(sFileName, ReadOnly:=True, Local:=True)
Set ws = wbk.Worksheets(SOURCESHT)
Dim rg As Range
' Set the range
Set rg = ws.Range(REP_START).CurrentRegion
Dim i As Long, oItem As clsAris, sKey As String, sStep As String, dict As New Scripting.Dictionary, sArr() As String, x As Long, sItem As String, lSecDot As Long
' Dim oObj As clsAris
' Loop through the file and write to a class object
For i = 1 To rg.Rows.Count
'If i = 63 Then Stop
With rg.Cells(i, 1)
If .Value = RELATETYPE Then ' This denotes the end of the function rows for the current function Id (Identifier)
sStep = ""
' This is a function, which we need to write to a flat file format, with all relevant properties
' Will use a dictionary and a class (clsAris) to hold the individual properties
ElseIf .Value = IDENT Then
sStep = IDENT
sKey = ""
' Note ARISModel is a Public Enum
' Find the second dot
lSecDot = SecondDot(Trim(.Offset(0, ARISModel.COLB).Value))
' Find the link to the L2 Process
sItem = Left(Trim(.Offset(0, ARISModel.COLB).Value), lSecDot)
' Put the identifier in an array and pad the identifier with leading zeros
sArr = Split(.Offset(0, ARISModel.COLB).Value, ".")
' Build the key to use. Loop through each array element padding to 3 characters, add the "." (dot) back in after each iteration
For x = LBound(sArr) To UBound(sArr)
sKey = sKey & Right("00" & Trim(sArr(x)), 3) & "."
Next x
' Remove the last dot - not needed
sKey = Left(sKey, Len(sKey) - 1)
End If
' If sStep = IDENT (a function) add to dictionary and fill the relevant class property in subsequent loops
If sStep = IDENT Then
' Check if Key exists in the dictionary, and if not add it
If Not dict.Exists(sKey) Then
Set oItem = New clsAris
dict.Add sKey, oItem
' add the L2 Process value to the L2Process Class property
' This only needs doing when the key is first added to the dictionary
dict(sKey).L2Process = sItem
Else
Set oItem = dict(sKey)
End If
' Check if the current field value is in the class properties
' This dictionary (dictARIS) just holds the lookup value (Key) from the worksheet and the related class property (item)
' There may be a better way of doing this (above), but at this point...
If dictARIS.Exists(.Value) Then
' Based on value of cell, populate the relevant class Property, there must be a more efficient solution to
' using Select Case (which does work, but if there are 500 Preoperties to fill...)
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' This works when the class object is first created but not when the next loop to populate the next property
' ERROR HERE........
CallByName oItem, .Value, VbLet, Trim(.Offset(0, ARISModel.COLB).Value)
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' Populated the relevant Classa Property based on cell value - this all works but want to use CallByName...
' Select Case .Value
' Case "Identifier"
' dict(sKey).Identifier = Trim(.Offset(0, ARISModel.COLB).Value)
' Case "Full name"
' dict(sKey).FullName = .Offset(0, ARISModel.COLB).Value
' Case "Time of generation"
' dict(sKey).TimeOfGeneration = .Offset(0, ARISModel.COLB).Value
' Case "Creator"
' dict(sKey).Creator = .Offset(0, ARISModel.COLB).Value
' Case "Last change"
' dict(sKey).LastChange = .Offset(0, ARISModel.COLB).Value
' Case "Last user"
' dict(sKey).LastUser = .Offset(0, ARISModel.COLB).Value
' Case "Package Flag"
' dict(sKey).PackageFlag = .Offset(0, ARISModel.COLB).Value
' Case "IP Code"
' dict(sKey).IPCode = .Offset(0, ARISModel.COLB).Value
' Case "Multiple Systems (SAP, C4C, Opentex)"
' dict(sKey).MultipleSystems = .Offset(0, ARISModel.COLB).Value
' Case "Orphan"
' dict(sKey).Orphan = .Offset(0, ARISModel.COLB).Value
' Case "Description/Definition"
' dict(sKey).Desc = .Offset(0, ARISModel.COLB).Value
' Case "Display Supporting"
' dict(sKey).DisplaySupporting = .Offset(0, ARISModel.COLB).Value
' Case "User Defined Field 01 - Value"
' dict(sKey).UDF01 = .Offset(0, ARISModel.COLB).Value
' Case "Person responsible"
' dict(sKey).PersonResponsible = .Offset(0, ARISModel.COLB).Value
' Case "Task Type"
' dict(sKey).TaskType = .Offset(0, ARISModel.COLB).Value
' Case "T-Code Execution"
' dict(sKey).TCodeExecution = .Offset(0, ARISModel.COLB).Value
' Case "Training Course"
' dict(sKey).TrainingCourse = .Offset(0, ARISModel.COLB).Value
' Case "Form"
' dict(sKey).Frm = .Offset(0, ARISModel.COLB).Value
' Case "Control activity"
' dict(sKey).ControlActivity = .Offset(0, ARISModel.COLB).Value
' Case "Management Reports"
' dict(sKey).ManagementReports = .Offset(0, ARISModel.COLB).Value
' Case "Task"
' dict(sKey).Task = .Offset(0, ARISModel.COLB).Value
' Case "Group"
' dict(sKey).Grp = .Offset(0, ARISModel.COLB).Value
' Case Else
' End Select
Else: End If
Else: End If
End With
Next
Set GetSourceData = dict
Done:
' Set rg = Nothing
Set dict = Nothing
If sFileName <> "" Then wbk.Close 'Savechanges:=False
Exit Function
EH:
MsgBox Err.Description & " mdlMain : GetSourceData "
Resume Done
End Function
clsAris代码
Option Explicit
Public L2Process As String
Public Identifier As String
Public FullName As String
Public TimeOfGeneration As String
Public Creator As String
Public LastChange As String
Public LastUser As String
Public PackageFlag As String
Public IPCode As String
Public MultipleSystems As String
Public Orphan As String
Public Desc As String
Public DisplaySupporting As String
Public UDF01 As String
Public PersonResponsible As String
Public TaskType As String
Public TCodeExecution As String
Public TrainingCourse As String
Public Frm As String
Public ControlActivity As String
Public ManagementReports As String
Public Task As String
Public Grp As String
Public Property Get InfoArray() As Variant
' Put the class properties into an Array for printing to the worksheet
InfoArray = Array(L2Process, Identifier, FullName, TimeOfGeneration, Creator, LastChange, LastUser, PackageFlag, _
IPCode, MultipleSystems, Orphan, Desc, DisplaySupporting, UDF01, PersonResponsible, _
TaskType, TCodeExecution, TrainingCourse, Frm, ControlActivity, ManagementReports, _
Task, Grp)
End Property