Sub FormatoStock de HM

Hola de nuevo. Aqui va la macro con algunas correcciones y una pequeña
aclaracion al principio de la misma en forma de comentario.

Gracias y hasta pronto.
Ivan

Option Explicit

' Ejemplo de inventario impreso para dar de baja manualmente las _
existencias de articulos:las columnas a, b, c y d contienen _
respectivamente: referencia, color, talla, articulo. En la _
columna E iria el inventario impreso, formado por tantas I _
como stock tengamos de cada articulo.A su vez cada I sera de _
un color segun su ubicacion o estado (vendido, en tienda, en _
almacen, recien recibido o tarado) y podemos colocar un _
separador(.) cada x I para facilitar su vision. Los VENDIDOS _
(azul oscuro) pueden interesar a veces a titulo informativo. _
Normalmente trabajamos con los articulos en TIENDA(color rojo) _
que se iran tachando con un aspa segun se vendan, en ALMACEN y _
RECIBIDOS que iran en un color claro(oro) para poder pintar de _
rojo cuando se lleven a la tienda, y TARADOS(gris claro) para su _
posible devolucion, reparacion u oferta. Existe un sexsto campo _
LINEAS(blanco) que sirve para insertar saltos de linea en blanco _
de cara a dejar espacio a determinados articulos que trabajamos _
en bastante cantidad y no queremos tener que renovar cada vez que _
se reciben. Las cantidades de cada tipo de stock se introducen _
en las columnas H, I, J, K, L y M. Las columnas F y G se usan _
para precio de costo y pvp. El area de impresion seria de la _
columna A hasta la G, ambas incluidas. Empezamos en la fila _
5 para dejar espacio para los datos del proveedor y los _
encabezados de campo.

Dim PrInv As String, PrStk As String, Inv As Range, Celda As Range
Dim NumStk As Integer, PrOff As Integer, UlOff As Integer
Dim InOff As Integer

Sub OkPrueba1ConFormularioFormatoStock23F06()
Const I As String = " I " 'Cada I representa un articulo
' Grupo es cada cuantos articulos queremos poner un separador (.) _
para facilitar la cuenta de articulos
Dim Grupo As Integer, Texto As String
Dim Inicio As Integer, Fin As Integer, x, Color

PrInv = InputBox _
("Introduce la primera celda donde ira impreso el inventario.", _
"CELDA INICIAL INVENTARIO", "E5")
If PrInv = "" Then Exit Sub
NumStk = Val _
(InputBox("¿Cuantos estocajes quieres que se impriman.?" _
& "Elige una cantidad de 1 a 6.", "Nº de STOCKS", 6))
Do While NumStk = 0 Or NumStk < 1 Or NumStk > 6
If NumStk = 0 Then
x = MsgBox _
("¿Estas seguro de cancelar la actualizacion?", _
vbRetryCancel, "CANCELAR ACTUALIZACION")
If x = vbCancel Then
Exit Sub
Else
NumStk = Val(InputBox _
("¿Cuantos estocajes quieres que se impriman.?" _
& "Elige una cantidad de 1 a 6.", "Nº de STOCKS", 6))
End If
ElseIf NumStk < 1 Or NumStk > 6 Then
x = MsgBox _
("Has introducido un Nº erroneo." & _
"Introduce un Nº de 1 a 6", vbRetryCancel, _
"Nº ERRONEO DE STOCKS")
If x = vbCancel Then
Exit Sub
Else
NumStk = Val(InputBox _
("¿Cuantos estocajes quieres que se impriman.?" _
& "Elige una cantidad de 1 a 6.", "Nº de STOCKS", 6))
End If
End If
Loop
PrStk = InputBox _
("Introduce la primera celda para los stocks de articulos.", _
"PRIMERA CELDA EXISTENCIAS", "H5")
Do While PrStk = ""
If PrStk = "" Then
x = MsgBox _
("¿Estas seguro de cancelar la actualizacion?", _
vbRetryCancel, "CANCELAR ACTUALIZACION")
If x = vbCancel Then
Exit Sub
Else
PrStk = InputBox _
("Introduce la primera celda para los stocks de articulos.", _
"PRIMERA CELDA EXISTENCIAS", "H5")
End If
End If
Loop
Do While Range(PrStk).Column = Range(PrInv).Column Or Range(PrStk) _
.Column < Range(PrInv).Column And Range(PrStk).Column _
+ NumStk >= Range(PrInv).Column
If Range(PrStk).Column = Range(PrInv).Column Or Range(PrStk) _
.Column < Range(PrInv).Column And Range(PrStk).Column _
+ NumStk >= Range(PrInv).Column Then
x = MsgBox _
("Celda no valida." & _
" Elige una celda de una columna posterior a " & PrInv _
& " o si es anterior que al menos este separada de " _
& PrInv & " en " & NumStk + 1 & " columnas.", _
vbRetryCancel, "CANCELAR ACTUALIZACION")
If x = vbCancel Then
Exit Sub
Else
PrStk = InputBox _
("Introduce la primera celda para los stocks de articulos.", _
"PRIMERA CELDA EXISTENCIAS", "H5")
End If
End If
Loop
Grupo = Val(InputBox("¿Cuantos articulos quieres agrupar con separador.?",
_
"AGRUPAR ARTICULOS", 5))
If Grupo = vbCancel Then
x = MsgBox("¿Deseas continuar sin separador de articulos?", _
vbOKCancel, "NO AGRUPAR ARTICULOS")
If x = vbOK Then
Grupo = 0
Else
Exit Sub
End If
End If
Texto = Application.Rept(I, Grupo)
Select Case NumStk
Case 1
Color = Array(44)
Case 2
Color = Array(3, 44)
Case 3
Color = Array(3, 44, 44)
Case 4
Color = Array(3, 44, 44, 15)
Case 5
Color = Array(5, 3, 44, 44, 15)
Case 6
Color = Array(5, 3, 44, 44, 15, 2)
End Select
Application.ScreenUpdating = False
Set Inv = Range(Range(PrInv), Range("A65000").End(xlUp) _
.Offset(, Range(PrInv).Column - 1).Address)
With Inv.Font: .Bold = True: .Name = "Arial": .Size = 16: End With
PrOff = Range(PrStk).Column - Inv.Column
UlOff = PrOff + NumStk - 1
For Each Celda In Inv
With Application
Celda = .Substitute(.Rept(I, _
.Sum(Range(Celda.Offset(, PrOff), Celda.Offset(, UlOff)))), _
Texto, Texto & ".")
For InOff = PrOff To UlOff
If InOff = PrOff Then
Inicio = 1
Fin = Len(.Substitute(.Rept(I, _
Celda.Offset(, InOff)), _
Texto, Texto & "."))
ElseIf InOff > PrOff And InOff < UlOff Then
Inicio = Len(.Substitute(.Rept(I, _
.Sum(Range(Celda.Offset(, PrOff), _
Celda.Offset(, InOff - 1)))), _
Texto, Texto & ".")) + 1
Fin = Len(.Substitute(.Rept(I, _
.Sum(Range(Celda.Offset(, PrOff), Celda.Offset _
(, InOff)))), Texto, Texto & "."))
ElseIf InOff = UlOff Then
Inicio = Len(.Substitute(.Rept(I, _
.Sum(Range(Celda.Offset(, PrOff), Celda _
.Offset(, InOff - 1)))), Texto, _
Texto & ".")) + 1
Fin = Len(Celda)
End If
Celda.Characters(Inicio, Fin).Font.ColorIndex = _
Color(InOff - PrOff)
Next InOff
End With
Next Celda
Inv.WrapText = True
End Sub

Sub BorrarInventario()
Dim x
x = MsgBox _
("¿Quieres borrar la anterior actualizacion del inventario?", _
vbYesNo, "BORRAR INVENTARIO")
PrInv = InputBox _
("Introduce la primera celda del campo inventario.", _
"COLUMNA INVENTARIO", "E5")
If PrInv = "" Then Exit Sub
NumStk = Val(InputBox("¿Cuantos estocajes quieres que se borren.?" _
& "Escribe una cantidad de 1 a 6.", _
"Nº de STOCKS", 6))
Do While NumStk = 0 Or NumStk < 1 Or NumStk > 6
If NumStk = 0 Then
x = MsgBox("¿Quieres cancelar el borrado de campos?",
vbRetryCancel, _
"CANCELAR BORRADO DE CAMPOS")
If x = vbCancel Then
Exit Sub
Else
NumStk = Val(InputBox("¿Cuantos estocajes quieres que se borren.?"
_
& "Escribe una cantidad de 1 a 6.", "Nº de STOCKS", 6))
End If
ElseIf NumStk < 1 Or NumStk > 6 Then
x = MsgBox("¿Has introducido un Nº erroneo?" & "Introduce un Nº de
1 a 6", _
vbRetryCancel, "Nº ERRONEO DE STOCKS")
If x = vbCancel Then
Exit Sub
Else
NumStk = Val(InputBox("¿Cuantos estocajes quieres que se
borren.?" _
& "Escribe una cantidad de 1 a 6.", _
"Nº de STOCKS", 6))
End If
End If
Loop
PrStk = InputBox _
("Introduce la primera celda donde van los articulos " _
& "a borrar.", "PRIMERA CELDA CANTIDAD STOCK", "H5")
Do While PrStk = ""
If PrStk = "" Then
x = MsgBox("¿Estas seguro de que no quieres borrar los campos?", _
vbRetryCancel, "CANCELAR BORRADO DE CAMPOS")
If x = vbCancel Then
Exit Sub
Else
PrStk = InputBox _
("Introduce la primera celda donde van los articulos a
borrar.", _
"PRIMERA CELDA STOCK", "H5")
End If
End If
Loop
Do While Range(PrStk).Column = Range(PrInv).Column Or Range(PrStk) _
.Column < Range(PrInv).Column And Range(PrStk).Column + NumStk >= _
Range(PrInv).Column
If Range(PrStk).Column = Range(PrInv).Column Or Range(PrStk) _
.Column < Range(PrInv).Column And Range(PrStk).Column + NumStk >= _
Range(PrInv) _
.Column Then
x = MsgBox _
("Celda no valida." & _
" Elige una celda de una columna posterior a " & PrInv _
& " o si es anterior que al menos este separada de " &
_
PrInv & " en " & NumStk + 1 & " columnas.", _
vbRetryCancel, "CORREGIR CELDA INICIAL")
If x = vbCancel Then
Exit Sub
Else
PrStk = InputBox _
("Introduce la primera celda donde van los articulos a
borrar.", _
"PRIMERA CELDA CANTIDAD STOCK", "H5")
End If
End If
Loop
Set Inv = Range(Range(PrInv), Range("A65000").End(xlUp) _
.Offset(, Range(PrInv).Column - 1).Address)
If x = vbYes Then
Inv.ClearContents
Range(Range(PrStk),
Range(Range(PrStk).Offset(Range("a65000").End(xlUp).Row, _
Range(PrStk).Offset(, Range(PrStk).Column + NumStk -
1).Column) _
.Address)).Value = 0
End If

End Sub

Hola a todos.

Este mensaje va dirigido fundamentalmente para Héctor Miguel pues es la
continuación de una serie de consultas anteriores. No obstante esta
abierto a cualquiera, como, supongo, todos los del foro.
Hola Héctor Miguel (espero que puedas atender este mensaje), no se si
recordaras la macro FormatoStock que me mandaste, pero ha sido con la que
mas he aprendido VBA hasta ahora. No sabes lo que te lo agradezco. No
obstante seguía dándome algunos fallos (no se si por trascripción) con los
ceros-creo-. Al final basándome en ella he sacado esta otra, pero supongo
que es muy optimizable. Si tienes tiempo y puedes me gustaría saber tu
opinión (y la de cualquiera) sobre ella. Es un poco una forma de aprender
un poco más.
Por otro lado no he coseguido entender el proposito de ScrollArea en la
macro que me mandaste. No acabo de entender el rango al que se refiere, si
es a "Fijo"("$G$1:$L$1") en si mismo o se va extendiendo hasta la ultima
fila con datos, ni tampoco la utilidad exacta.

En cualquier caso, muchas gracias.
Un saludo y hasta pronto.
Ivan

PD: adjunto otra macro para borrar los stocks que supongo tambien es muy
mejorable.
PPD: Ojo a los saltos de linea, los he rectificado en el mismo mensaje y
no se si no me habre equivocado en algo.

-