Featured Replies
Archivado
Este tema está ahora archivado y está cerrado a más respuestas.
A better way to browse. Learn more.
A full-screen app on your home screen with push notifications, badges and more.
Este tema está ahora archivado y está cerrado a más respuestas.
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.
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
[b][size=4][color=Blue]Clase ClaseRango[/color][/size][/b]
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