Excel+Activex+VB+VBA
Publicado por JuanC (792 intervenciones) el 26/05/2008 20:56:56
Por esas cosas de la vida me encontré programando un Control Activex en VB
y también por esas cosas... se me ocurrió que podría vincular el control con una
planilla de Excel... y usar ese control en VBA...
Aquí una aproximación burda, como para empezar...
El componente es un Combo (podría ser cualquiera)
Option Explicit
'//By JuanC - May. 2008
Private m_sSheet As String
Private m_sRange As String
Public Property Let SheetName(ByVal sName As String)
m_sSheet = sName
End Property
Public Property Let Range(ByVal sRng As String)
m_sRange = sRng
End Property
Public Sub GetValues()
Dim XL As Object
Dim Sheet As Object
Dim obj As Object, Rng As Object
On Error Resume Next
If Trim(m_sSheet) = "" Or Trim(m_sRange) = "" Then Exit Sub
Set XL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, "Error"
Exit Sub
End If
Set Sheet = XL.worksheets(m_sSheet)
If Not Sheet Is Nothing Then
Set Rng = Sheet.Range(m_sRange)
If Not Rng Is Nothing Then
'//Llenar en componente con los valores del rango
Combo1.Clear
For Each obj In Rng
Combo1.AddItem obj.Value
Next
End If
End If
If Combo1.ListCount > 0 Then Combo1.ListIndex = 0
Set Sheet = Nothing
Set XL = Nothing
Set obj = Nothing
End Sub
Private Sub UserControl_InitProperties()
m_sSheet = ""
m_sRange = ""
End Sub
Saludos desde Baires, JuanC
y también por esas cosas... se me ocurrió que podría vincular el control con una
planilla de Excel... y usar ese control en VBA...
Aquí una aproximación burda, como para empezar...
El componente es un Combo (podría ser cualquiera)
Option Explicit
'//By JuanC - May. 2008
Private m_sSheet As String
Private m_sRange As String
Public Property Let SheetName(ByVal sName As String)
m_sSheet = sName
End Property
Public Property Let Range(ByVal sRng As String)
m_sRange = sRng
End Property
Public Sub GetValues()
Dim XL As Object
Dim Sheet As Object
Dim obj As Object, Rng As Object
On Error Resume Next
If Trim(m_sSheet) = "" Or Trim(m_sRange) = "" Then Exit Sub
Set XL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, "Error"
Exit Sub
End If
Set Sheet = XL.worksheets(m_sSheet)
If Not Sheet Is Nothing Then
Set Rng = Sheet.Range(m_sRange)
If Not Rng Is Nothing Then
'//Llenar en componente con los valores del rango
Combo1.Clear
For Each obj In Rng
Combo1.AddItem obj.Value
Next
End If
End If
If Combo1.ListCount > 0 Then Combo1.ListIndex = 0
Set Sheet = Nothing
Set XL = Nothing
Set obj = Nothing
End Sub
Private Sub UserControl_InitProperties()
m_sSheet = ""
m_sRange = ""
End Sub
Saludos desde Baires, JuanC
Valora esta pregunta


0