ClaseRango: Clonar un objeto de la clase Range con sus propias propiedades y atributos.

[verzulsan]

Hola

Esta es la primera clase que hago en VB, idea surgida a raíz de una consulta que hice en este mismo foro.

Dicha ClaseRango permite crear objetos que toman los atributos de las celdas asociadas a un objeto Range (tantos atributos como queramos implementar) y luego permite devolver los datos a la celda que nos interese.

Lo interesante de esto es, que para manejar los datos de celdas una vez están en los objetos ClaseRango, no es necesario que estén linkados a una celda, se manejan como una variable mas.

Ventajas: El método de copia "Copy" entre objetos de la propia ClaseRango es bastante más rápido que manipular las celdas dentro del entorno de la hoja además de no necesitar desactivar Refresco con Application.Screenupdating, bastante rápido.

Desventajas: La única pega es, que la interacción de los objetos ClaseRango y Range mediante los métodos CopyRange y PasteRange es, (Permítaseme la invención de la palabra), decepcionalmente lenta.

NOTA: Esta es una versión beta. No está implementada la copia exacta.

Únicamente he implementado el objeto Interior perteneciente al objeto Range. Los objetos Borders' date=' Comment, Font, Hyperlinks y Style contenidos en el objeto Range, no han sido implementados. Pero es tan fácil como rellenar los espacios que aparecen tras los comentarios en la hoja. Lo he diseñado lo mas sencillo de entender que he podido para que pueda ser mejorado por otros de manera facil siguiendo las instrucciones y notas, por si alguien necesita meterle más propiedades o incluirle algunas mejoras.

Bueno, pues ahí les dejo el archivo, dentro hay un pequeño tutorial con un ejemplo comentando como funciona la clase con sus métodos y propiedades. Expongo el código tambien para que sea indexado por Google.

User Defined Type

Type TipoBorders

    'Sin implementar

    ImplementarVariables As Variant

End Type

Type TipoComment

    'Sin implementar

    ImplementarVariables As Variant

End Type

Type TipoFont

    'Sin implementar

    ImplementarVariables As Variant

End Type

Type TipoHyperlinks

    'Sin implementar

    ImplementarVariables As Variant

End Type

Type TipoInterior

    Color  As Variant

    ColorIndex  As Variant

    Pattern  As Variant

    PatternColor  As Variant

    PatternColorIndex  As Variant

End Type

Type TipoStyle

    'Sin implementar

    ImplementarVariables As Variant

End Type


Type TipoRango

    AddIndent  As Variant

    'Borders      (Objeto Sin implementar)

    ColumnWidth  As Variant

    'Comment      (Objeto Sin implementar)

    'Font         (Objeto Sin implementar)

    Formula  As Variant

    'Hyperlinks   (Objeto Sin implementar)

    'Interior     (Objeto IMPLEMENTADO)

        Interior As TipoInterior

    Locked  As Variant

    MergeCells  As Variant

    NumberFormat  As Variant

    NumberFormatLocal  As Variant

    Orientation  As Variant

    ReadingOrder  As Long

    RowHeight  As Variant

    ShrinkToFit  As Variant

        'Style    (Objeto Sin implementar)

    UseStandardHeight  As Variant

    UseStandardWidth  As Variant

    Value As Variant

    VerticalAlignment  As Variant

    WrapText  As Variant

End Type[/CODE]

[b][size=4][color=Blue]Clase ClaseRango[/color][/size][/b]

[CODE]Private RangoPrivado As TipoRango

Friend Sub SetRango(NuevoRango As TipoRango)
RangoPrivado = NuevoRango
End Sub

Friend Sub SetRevRango(NuevoRango As TipoRango)
NuevoRango = RangoPrivado
End Sub

Public Function Copy(Optional RangoPorParametro As ClaseRango) As ClaseRango
If RangoPorParametro Is Nothing Then
Dim ResClase As ClaseRango
Set ResClase = New ClaseRango
Call ResClase.SetRango(RangoPrivado)
Set Copy = ResClase
Else
Call RangoPorParametro.SetRevRango(RangoPrivado)
End If
End Function

Public Function CopyRange(RangoPorCelda As Variant)
If TypeName(RangoPorCelda) = "String" Then
Set RangoPorCelda = Range(RangoPorCelda)
End If
With RangoPorCelda.Cells(1, 1)
RangoPrivado.AddIndent = .AddIndent
'Objeto.Borders
'(Objeto sin implementar)
RangoPrivado.ColumnWidth = .ColumnWidth
'Objeto.Comment
'(Objeto sin implementar)
'Objeto.Font
'(Objeto sin implementar)
RangoPrivado.Formula = .Formula
'Objeto.Hyperlinks
'(Objeto sin implementar)
'Objeto.Interior
RangoPrivado.Interior.Color = .Interior.Color
RangoPrivado.Interior.ColorIndex = .Interior.ColorIndex
RangoPrivado.Interior.Pattern = .Interior.Pattern
RangoPrivado.Interior.PatternColor = .Interior.PatternColor
RangoPrivado.Interior.PatternColorIndex = .Interior.PatternColorIndex
RangoPrivado.Locked = .Locked
RangoPrivado.MergeCells = .MergeCells
RangoPrivado.NumberFormat = .NumberFormat
RangoPrivado.NumberFormatLocal = .NumberFormatLocal
RangoPrivado.Orientation = .Orientation
RangoPrivado.ReadingOrder = .ReadingOrder
RangoPrivado.RowHeight = .RowHeight
RangoPrivado.ShrinkToFit = .ShrinkToFit
'Objeto.Style
'(Objeto sin implementar)
RangoPrivado.UseStandardHeight = .UseStandardHeight
RangoPrivado.UseStandardWidth = .UseStandardWidth
RangoPrivado.VerticalAlignment = .VerticalAlignment
RangoPrivado.Value = .Value
RangoPrivado.WrapText = .WrapText
End With
End Function

Public Function PasteRange(RangoPorCelda As Variant)
If TypeName(RangoPorCelda) = "String" Then
Set RangoPorCelda = Range(RangoPorCelda)
End If
With RangoPorCelda.Cells(1, 1)
.AddIndent = RangoPrivado.AddIndent
'Objeto.Borders

.ColumnWidth = RangoPrivado.ColumnWidth
'Objeto.Comment

'Objeto.Font

.Formula = RangoPrivado.Formula
'Objeto.Hyperlinks

'Objeto.Interior
.Interior.Color = RangoPrivado.Interior.Color
.Interior.ColorIndex = RangoPrivado.Interior.ColorIndex
.Interior.Pattern = RangoPrivado.Interior.Pattern
.Interior.PatternColor = RangoPrivado.Interior.PatternColor
.Interior.PatternColorIndex = RangoPrivado.Interior.PatternColorIndex
.Locked = RangoPrivado.Locked
.MergeCells = RangoPrivado.MergeCells
.NumberFormat = RangoPrivado.NumberFormat
.NumberFormatLocal = RangoPrivado.NumberFormatLocal
.Orientation = RangoPrivado.Orientation
.ReadingOrder = RangoPrivado.ReadingOrder
.RowHeight = RangoPrivado.RowHeight
.ShrinkToFit = RangoPrivado.ShrinkToFit
'Objeto.Style

.UseStandardHeight = RangoPrivado.UseStandardHeight
.UseStandardWidth = RangoPrivado.UseStandardWidth
.VerticalAlignment = RangoPrivado.VerticalAlignment
.Value = RangoPrivado.Value
.WrapText = RangoPrivado.WrapText
End With
End Function

'Plantilla de como podria modificarse individualmente cada variable
Public Property Let Value(Var As Variant)
RangoPrivado.Value = Var
End Property
Public Property Get Value() As Variant
Value = RangoPrivado.Value
End Property

Public Property Let InteriorColorIndex(Var As Variant)
RangoPrivado.Interior.ColorIndex = Var
End Property
Public Property Get InteriorColorIndex() As Variant
InteriorColorIndex = RangoPrivado.Interior.ColorIndex
End Property
[/CODE]

Saludos

Copiar_Variable_vzs(BETA).zip