Concatenar con formato.

05/02/2006 - 05:19 por klomkbock | Informe spam
Hola a todos.
Encantado de estar de nuevo por aqui.

Esta consulta es sobre una macro de Hector Miguel que he retocado para
adaptarla a mis necesidades. Aunque funciona bien para lo que la quiero,
me gustaria ser capaz de hacerla un poco mas versatil. La macro en
cuestion da diferentes colores a determinados caracteres de una misma
celda en funcion del valor que se introduce en otras. Me explico: se trata
de una hoja de inventario inpreso para dar de baja manualmente articulos.
Los campos serian: A=Referencia; B=Color; C=Talla; D=Articulo; E=Stok
(aqui irian las celdas con los formatos conbinados); F=Precio costo;
G=PVP; H=Cantidad de articulos en tienda; I=Cantidad en almacen;
J=Cantidad recibida. Las cantidades introducidas en H, I y J son las que
aparecen repetidas en forma de "I" en la columna E y con el formato que
determinemos para cada una de las cantidades. Ademas llevan un caracter de
separacion cada x caracteres para hacer mas facil contarlas visualmente.
Para este caso el codigo parece funcionar correctamente pero me gustaria
conseguir (lo estoy intentando) que por ej.

1-en vez de repetir en base a tres campos se pudiera elegir entre uno y
cinco o mas campos.

2-Ademas he tenido que usar la funcion REPLACE porque con STRING solo no
he conseguido que me repita " I " (la "I" con un espacio a cada lado),
pues toma el primer caracter (un espacio) y lo repite solamente a el ( sin
embargo la funcion REPETIR de la hoja de calculo si te repite todo el
conjunto). Pienso que si se elimina REPLACE quedaria un codigo mas
sencillo.

3-Tambien que al pedir de que campo se van a extraer las cantidades, este
se pudiera introducir con formato "A2:Ax" y me lo aplicara a la propiedad
offset.

4-Aparte creo que el tratamiento de errores (aunque parece funcionar) no
esta bien puesto.

A continuacion pongo la macro (espero que con el permiso de HM -gracias de
nuevo-) que supongo sera muy mejorable. Cualquier consejo o correccion
sera bien recibida.

Un saludo y gracias de antemano.
Ivan

Sub RepetirConFormato11()

' Macro retocada por Ivan(27-01-06)
' sobre una macro original de Hector Miguel
Application.ScreenUpdating = False
Dim Celda As Range
Dim f As Integer, g As Integer
Dim h As String
Dim i As Integer, j As Integer, k As Integer
Dim li As String, lj As String, lk As String
Dim ih As String, jh As String, kh As String

On Error Resume Next

g = Val(InputBox("Introduce cada cuantos articulos quieres poner un
separador.", "AGRUPAR UNIDADES", 5))
h = Replace(String(g, "I"), "I", " I ")
f = Val(InputBox("¿A cuantas columnas esta el primer campo de
articulos?", "CAMPOS ARTICULOS"))
For Each Celda In Range(InputBox("Introduce el rango para el STOK", _
"RANGO STOK", "E2:"))

i = Celda.Offset(, f).Value
j = Celda.Offset(, f + 1).Value
k = Celda.Offset(, f + 2).Value

li = Replace(String(i, "I"), "I", " I ")
lj = Replace(String(j, "I"), "I", " I ")
lk = Replace(String(k, "I"), "I", " I ")

ih = Replace(li, h, h & ".")
jh = Replace(li & lj, h, h & ".")
kh = Replace(li & lj & lk, h, h & ".")

With Celda

.Value = kh

'Da formato independiente a cada grupo de " I " correspondiente a
cada campo.

With .Characters(1, Len(ih)).Font

.ColorIndex = 3 'Stok tienda = Color rojo
.Bold = True
.Name = "Arial"
.Size = 16

End With
With .Characters(Len(ih) + 1, Len(jh) - Len(ih)).Font

.ColorIndex = 44 'Stok almacen = Color oro
.Bold = True
.Name = "Arial"
.Size = 16

End With
With .Characters(Len(jh) + 1, Len(kh) - Len(jh)).Font

.ColorIndex = 44 'Stok recibido = Color oro
.Bold = True
.Name = "Arial"
.Size = 16

End With
End With
Next Celda
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
 

Leer las respuestas

#1 klomkbock
05/02/2006 - 05:43 | Informe spam
Hola de nuevo.

Aqui pongo la macro original de Hector Miguel, sobre todo para aclarar que
cualquier posible error o burrada de la otra es culpa exclusivamente mia.

Tambien reiterar mis garcias a Hector Miguel (y a todos los que ayudais al
resto) y pedirte disculpas por usar tu nombre quizas en exceso.

Un saludo
Ivan

Sub ConcatenarVariasCeldasConFormato()
Application.ScreenUpdating = False
Dim Celda As Range
For Each Celda In Range("d1:d10")
With Celda
.Value = .Offset(, -3) & " " & .Offset(, -2) & " " & .Offset(, -1)
With .Characters(1, Len(.Offset(, -3))).Font
.ColorIndex = Celda.Offset(, -3).Font.ColorIndex
.Bold = Celda.Offset(, -3).Font.Bold
.Italic = Celda.Offset(, -3).Font.Italic
.Name = Celda.Offset(, -3).Font.Name
.Size = Celda.Offset(, -3).Font.Size
.Underline = Celda.Offset(, -3).Font.Underline
End With
With .Characters(Len(.Offset(, -3)) + 2, Len(.Offset(, -2))).Font
.ColorIndex = Celda.Offset(, -2).Font.ColorIndex
.Bold = Celda.Offset(, -2).Font.Bold
.Italic = Celda.Offset(, -2).Font.Italic
.Name = Celda.Offset(, -2).Font.Name
.Size = Celda.Offset(, -2).Font.Size
.Underline = Celda.Offset(, -2).Font.Underline
End With
With .Characters(Len(.Offset(, -3) & .Offset(, -2)) + 3,
Len(.Offset(,
-1))).Font
.ColorIndex = Celda.Offset(, -1).Font.ColorIndex
.Bold = Celda.Offset(, -1).Font.Bold
.Italic = Celda.Offset(, -1).Font.Italic
.Name = Celda.Offset(, -1).Font.Name
.Size = Celda.Offset(, -1).Font.Size
.Underline = Celda.Offset(, -1).Font.Underline
End With
End With
Next
End Sub

Preguntas similares