AW: Danke Mullit, aber es gibt noch Probleme
16.01.2019 21:07:15
Mullit
Hallo,
ja hatte ich schon ges., war aber zeitlich eingespannt; das mußt Du natürlich noch auf Deine Bedürfnisse anpassen, die Range-Klasse enthält ja unzählige Objekte und Methoden, der Code ist da nur ein Entwurf, mußt halt selbst weiterproggen ;-).
Aber bei den von Dir aufgezählten Eigensch. ist die Borders-Eig. die einzige, die einen Fehler wirft und das liegt an ihrem Parameter, das müsstest Du ebenfalls in der Function abfangen, mal ein Bsp. ...
Option Explicit
Public Sub test()
Dim avntArray() As Variant
Dim strSubCmd As String, strText As String
Dim ialngIndex As Long
avntArray = Array("RowHeight", "ColumnWidth", "Value", "NumberFormat", _
"font.bold", "font.underline", "font.italic", "font.color", _
"font.name", "Interior.Color", "Interior.ColorIndex", _
"Borders(xlDiagonalDown).LineStyle")
For ialngIndex = 0 To Ubound(avntArray)
strSubCmd = avntArray(ialngIndex)
strText = strText & avntArray(ialngIndex) & ": " & _
fncCallByName_SubCmd(Cells(1, 1), strSubCmd, VbGet) & vbCr
Next
Call MsgBox(strText)
End Sub
Private Function fncCallByName_SubCmd(ByRef probjObject As Object, _
ByVal pvstrProcName As String, ByVal pvenmCallType As VbCallType) As Variant
Dim objReturn As Object
Dim lngPos As Long, lngPos2 As Long, lngIndex As Long
lngPos = InStr(pvstrProcName, ".")
lngPos2 = InStr(pvstrProcName, "(")
If lngPos = 0 Then
If Not IsObject(CallByName(probjObject, pvstrProcName, pvenmCallType)) Then _
fncCallByName_SubCmd = CallByName(probjObject, pvstrProcName, pvenmCallType)
ElseIf lngPos2 <> 0 Then
lngIndex = fncStringToEnum(Mid$(String:=pvstrProcName, Start:=lngPos2 + 1, _
Length:=InStr(pvstrProcName, ")") - lngPos2 - 1))
If lngIndex <> 0 Then
Set objReturn = CallByName(probjObject, _
Mid$(String:=pvstrProcName, Start:=1, Length:=lngPos2 - 1), _
pvenmCallType, lngIndex)
End If
Else
Set objReturn = CallByName(probjObject, _
Mid$(String:=pvstrProcName, Start:=1, Length:=lngPos - 1), pvenmCallType)
End If
If Not objReturn Is Nothing Then
pvstrProcName = Mid$(String:=pvstrProcName, Start:=lngPos + 1)
fncCallByName_SubCmd = CallByName(objReturn, pvstrProcName, pvenmCallType)
Set objReturn = Nothing
End If
End Function
Private Function fncStringToEnum(ByVal pvstrXlBordersIndex As String) As XlBordersIndex
Select Case pvstrXlBordersIndex
Case Is = "xlDiagonalDown": fncStringToEnum = xlDiagonalDown
Case Is = "xlDiagonalUp": fncStringToEnum = xlDiagonalUp
Case Is = "xlEdgeBottom": fncStringToEnum = xlEdgeBottom
Case Is = "xlEdgeLeft": fncStringToEnum = xlEdgeLeft
Case Is = "xlEdgeRight": fncStringToEnum = xlEdgeRight
Case Is = "xlEdgeTop": fncStringToEnum = xlEdgeTop
Case Is = "xlInsideHorizontal": fncStringToEnum = xlInsideHorizontal
Case Is = "xlInsideVertical": fncStringToEnum = xlInsideVertical
End Select
End Function
VBA/HTML - CodeConverter für Office-Foren
AddIn für Excel/Word 2000-2010 - komplett in VBA geschrieben von Lukas Mosimann
Projektbetreuung durch mumpel
Code erstellt und getestet in Office 14
Gruß, Mullit