Formatos de celda dinámicos

K

kratk

New Member
Joined
Oct 25, 2010
Messages
19
Hola:

Mi duda es la siguiente. necesito crear una macro que, con 2 valores input, me genere los formatos de celda de acuerdo a los valores input.

Ejemplo:
Carreras universitarias = 3 (Ingeniería, Humanidades, Técnico)
Ingeniería = Comercial, Informática, Minas
Humanidades = Filosofía, Antropología, Sociología
Técnico = Automatización, instrumentación, análisis de sistemas.

Yo ingreso el N° de carreras = 3 y el N° de Subramas = 3 y la macro me generará sola los formatos de "Merge Cells", "Borders" ,Etc. Especialmente en la zona de filas (Ya que la zona de columnas, donde irá la asistencia, notas, etc. se mantiene constante).

En resumen, buclear un formato con 2 parámetros de entrada.

De antemano Muchas Gracias por su ayuda
 
Sort by date Sort by votes
Marcelo: Hay alguna forma de hacer depender el N° de dispositivos del N° de veces??? algo así como lo hiciste con el N° de eventos con el N° de dispositivos. Te lo pregunto porque si cambio el N° de veces se me descompagina la tabla. Yo hice algo así:

Sub Formato()
Dim NumGeofonos As Long, NumEventos As Long, NumCorr As Long
Dim i As Long, j As Long, k As Long, l As Long, m As Long


NumEventos = Application.InputBox _
(Prompt:="Ingrese N° de eventos", Type:=1)
If NumEventos < 1 Then Exit Sub
NumEventos = CInt(NumEventos)

NumGeofonos = Application.InputBox _
(Prompt:="Ingrese N° de geofonos", Type:=1)
If NumGeofonos < 1 Then Exit Sub
NumGeofonos = CInt(NumGeofonos)

NumCorr = Application.InputBox _
(Prompt:="Ingrese N° de Tiros por Corrida", Type:=1)
If NumCorr < 1 Then Exit Sub
NumNumCorr = CInt(NumCorr)
j = 3
k = j + NumGeofonos * 5 - 1

For i = 1 To NumEventos
With ThisWorkbook.Sheets("Plan1").Range("A" & j & _
":A" & k)
.VerticalAlignment = xlCenter
.MergeCells = True
.Value = "Evento no." & i
.Cells(1, 1).Select

With Selection
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With

j = k + 1
k = j + NumGeofonos * 5 - 1
End With
Next i
Range("A:A").EntireColumn.AutoFit


j = 3
k = 7

For i = 1 To NumEventos
For l = 1 To NumGeofonos
With ThisWorkbook.Sheets("Plan1").Range("B" & j & ":B" & k)
.VerticalAlignment = xlCenter
.MergeCells = True
.Value = "Dispositivo " & l
.Cells(1, 1).Select
With Selection
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With
j = k + 1
k = k + 5
End With
Next l
Next i

Range("B:B").EntireColumn.AutoFit


With ThisWorkbook.Sheets("Plan1").Range("C2")
.Value = "No. Veces"
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With

m = 2

For i = 1 To NumEventos
For j = 1 To NumGeofonos
For l = 1 To NumCorr
m = m + 1
With ThisWorkbook.Sheets("Plan1").Range("C" & m)
.VerticalAlignment = xlCenter
.MergeCells = True
.Value = l
.Cells(1, 1).Select
With Selection
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.HorizontalAlignment = xlCenter
End With
End With
Next l
Next j
Next i

End Sub

Otra cosa, Se podría hacer un cuadro de dialogo que pregunte y almacene otro Nombre de Hoja y no dejar por defecto el "Plan1"?? te lo digo porque así haría mucho más autónoma la tabla.

Una vez muchisimas Gracias por tu ayuda.
P.D: No se como editas tu el codigo que te queda como en una ventana dentro del Post..... Me enseñas??
:biggrin:
 
Upvote 0

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Olá kratk

muchas preguntas..

Marcelo: Hay alguna forma de hacer depender el N° de dispositivos del N° de veces??? algo así como lo hiciste con el N° de eventos con el N° de dispositivos. Te lo pregunto porque si cambio el N° de veces se me descompagina la tabla.
Click to expand...

Quires decir que el No. Veces no és siempre 5 por dispositivo, és variable?
Humm...tengo que pensar como hacerlo...:confused:

Pero como sabés quantos són en cada uno de los dispositivos? Dime


Otra cosa, Se podría hacer un cuadro de dialogo que pregunte y almacene otro Nombre de Hoja y no dejar por defecto el "Plan1"?? te lo digo porque así haría mucho más autónoma la tabla.
Click to expand...

Esta és fácil :)

Crie una otra variable string y use un otro inputbox para obtener el nombre de la hoja.

Substitua en toda la macro "Plan1" por la variable.


P.D: No se como editas tu el codigo que te queda como en una ventana dentro del Post..... Me enseñas??
Click to expand...

Tambíén fácil :)

Utilize
Code: 
[I]pongo su codigo aqui[/I]

Hay un botón # qui hace eso automaricamente.
Y otros botones cerca para QUOTE, HTML, PHP.
Ponga el mouse sobre ellos y verás lo que hacen.

Una vez muchisimas Gracias por tu ayuda.
Click to expand...

És un placer ayudar :biggrin:

M.
 
Last edited:
Upvote 0
Otra cosa, Se podría hacer un cuadro de dialogo que pregunte y almacene otro Nombre de Hoja y no dejar por defecto el "Plan1"?? te lo digo porque así haría mucho más autónoma la tabla.
Click to expand...

Sorry, hay una manera mucho más fácil. No necesita la caja de texto (inputbox), ni escribir el nombre.

Code: 
Dim SheetName As String
 
SheetName = ActiveSheet.Name

y substitua en la macro "Plan1" por SheetName

M.
 
Upvote 0
Jajaja lo sé, son muchas preguntas.
en verdad los N° de veces son variables, dependen de cada evento, pero el For 1 to NumCorr lo ejecuta sin problemas, el problema es que se descompagina la tabla.
La idea es que el N° de veces dimensione la celda del N° de dispositivos (En mi caso N° de Tiros dimensione celdas del geófono)...... Me entiendes??? :LOL: :eek:.

Code: 
Sub Formato()
    Dim NumGeofonos As Long, NumEventos As Long, NumCorr As Long, NomHoja As String
    Dim i As Long, j As Long, k As Long, l As Long, m As Long
 
[COLOR=red]' Aquí no sé como almacenar una string como variable, ya que el string  convierte un numero en cadena.
[/COLOR]
    [COLOR=red]NomHoja = Application.InputBox _
        (Prompt:="Ingrese Nombre de Hoja", Type:=1)[/COLOR]
    
    
    NumGeofonos = CInt(NumGeofonos)
    NumEventos = Application.InputBox _
        (Prompt:="Ingrese N° de eventos", Type:=1)
    If NumEventos < 1 Then Exit Sub
    NumEventos = CInt(NumEventos)
 
    NumGeofonos = Application.InputBox _
        (Prompt:="Ingrese N° de geofonos", Type:=1)
    If NumGeofonos < 1 Then Exit Sub
    NumGeofonos = CInt(NumGeofonos)
 
    NumCorr = Application.InputBox _
        (Prompt:="Ingrese N° de Tiros por Corrida", Type:=1)
    If NumCorr < 1 Then Exit Sub
    NumCorr = CInt(NumCorr)
    j = 3
    k = j + NumGeofonos * 5 - 1
 
    For i = 1 To NumEventos
        With ThisWorkbook.Sheets("NomHoja").Range("A" & j & _
            ":A" & k)
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .Value = "Evento no." & i
            .Cells(1, 1).Select
 
            With Selection
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
           End With
 
           j = k + 1
           k = j + NumGeofonos * 5 - 1
        End With
    Next i
    Range("A:A").EntireColumn.AutoFit
 
    
    j = 3
    k = 7
 
    For i = 1 To NumEventos
        For l = 1 To NumGeofonos
        With ThisWorkbook.Sheets("NomHoja").Range("B" & j & ":B" & k)
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .Value = "Dispositivo " & l
            .Cells(1, 1).Select
            With Selection
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
           End With
        j = k + 1
        k = k + 5
       End With
       Next l
    Next i
 
    Range("B:B").EntireColumn.AutoFit
 
    
    With ThisWorkbook.Sheets("NomHoja").Range("C2")
        .Value = "No. Tiros"
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
    End With
 
    m = 2
 
    For i = 1 To NumEventos
        For j = 1 To NumGeofonos
             For l = 1 To NumCorr
                m = m + 1
                With ThisWorkbook.Sheets("NomHoja").Range("C" & m)
                    .VerticalAlignment = xlCenter
                    .MergeCells = True
                    .Value = l
                    .Cells(1, 1).Select
                    With Selection
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .HorizontalAlignment = xlCenter
                    End With
                End With
            Next l
        Next j
    Next i
 
End Sub

Eso es lo que modifiqué de tu macro, el problema es que soy nuevo en VBA y no sé como hacer el cuadro de dialogo que almacene el nombre de la hoja.
 
Upvote 0
Eso es lo que modifiqué de tu macro, el problema es que soy nuevo en VBA y no sé como hacer el cuadro de dialogo que almacene el nombre de la hoja.
Click to expand...

No necessitas. Vea mi respuesta anterior.

Pero si alguna vez necesita, haga exactamente lo que hice para obtener el número de eventos y dispositivos.

Crie una variable string, digamos NomHoja, y
NomHoja = Application.InputBox(Prompt:="Ingrese Nombre de Hoja", Type:=2)

Para string tiene que usar Type=2

Vea
http://www.ozgrid.com/VBA/inputbox.htm

M.




 
Upvote 0
en verdad los N° de veces son variables, dependen de cada evento, pero el For 1 to NumCorr lo ejecuta sin problemas, el problema es que se descompagina la tabla.
Click to expand...

Lo número de veces dependen del evento, y son los mismos para todos los dispostivos deste evento?

Es decir, si ingressamos con 3 para No.Veces todos los dispositivos serán com 3 lineas. És esto?


M.
 
Upvote 0
kratk,

Solución para No. Veces variable y para cualquier nombre de hoja

Code: 
Public Sub Eventos()
    Dim NumDispositivos As Long, NumEventos As Long, NumVeces As Long
    Dim i As Long, j As Long, k As Long, l As Long
    Dim SheetName As String
 
    SheetName = ActiveSheet.Name
 
    'Verificando los inputs
    NumEventos = Application.InputBox _
        (Prompt:="Ingrese numero de Eventos", Type:=1)
    If NumEventos < 1 Then Exit Sub
    NumEventos = CInt(NumEventos)
 
    NumDispositivos = Application.InputBox _
        (Prompt:="Ingrese numero de Dispositivos", Type:=1)
    If NumDispositivos < 1 Then Exit Sub
    NumDispositivos = CInt(NumDispositivos)
 
    NumVeces = Application.InputBox _
        (Prompt:="Ingrese Num Veces", Type:=1)
    If NumVeces < 1 Then Exit Sub
    NumVeces = CInt(NumVeces)
 
 
   'Inserindo los Eventos
    j = 3
    k = j + NumDispositivos * NumVeces - 1
 
    For i = 1 To NumEventos
        With ThisWorkbook.Sheets(SheetName).Range("A" & j & _
            ":A" & k)
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .Value = "Evento no." & i
            .Cells(1, 1).Select
 
            With Selection
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
           End With
 
           j = k + 1
           k = j + NumDispositivos * NumVeces - 1
        End With
    Next i
    Range("A:A").EntireColumn.AutoFit
 
    ' Inserindo los Dispositivos
    j = 3
    k = 3 + NumVeces - 1
 
    For i = 1 To NumEventos
        For l = 1 To NumDispositivos
        With ThisWorkbook.Sheets(SheetName).Range("B" & j & ":B" & k)
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .Value = "Dispositivo " & l
            .Cells(1, 1).Select
            With Selection
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
           End With
        j = k + 1
        k = k + NumVeces
       End With
       Next l
    Next i
 
    Range("B:B").EntireColumn.AutoFit
 
    ' Inserindo coluna C - No. Veces
    With ThisWorkbook.Sheets(SheetName).Range("C2")
        .Value = "No. Veces"
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .HorizontalAlignment = xlCenter
    End With
 
    l = 2
 
    For i = 1 To NumEventos
        For j = 1 To NumDispositivos
             For k = 1 To NumVeces
                l = l + 1
                With ThisWorkbook.Sheets(SheetName).Range("C" & l)
                    .VerticalAlignment = xlCenter
                    .MergeCells = True
                    .Value = k
                    .Cells(1, 1).Select
                    With Selection
                        .Borders(xlEdgeRight).LineStyle = xlContinuous
                        .Borders(xlEdgeLeft).LineStyle = xlContinuous
                        .Borders(xlEdgeTop).LineStyle = xlContinuous
                        .Borders(xlEdgeBottom).LineStyle = xlContinuous
                        .HorizontalAlignment = xlCenter
                    End With
                End With
            Next k
        Next j
    Next i    
 
End Sub

No me hagas más preguntas!

Es broma ...:LOL:

M.
 
Upvote 0
Marcelo:
Creo que es la última vez que te molesto jajajaja.
Esta Genial el código, a simple vista debiese funcionar perfecto. Lo que si, cuando le di "Run" a la macro, me arrojó el siguiente error.
Run-Time error '1004'
Application-Defined or object-Defined error.

La parte donde se produce el error es en la selección del rango (Te la señalaré con rojo en el código).
Code: 
For i = 1 To NumEventos
        With ThisWorkbook.Sheets(SheetName).Range("A" & j & _
            ":A" & k)
            .VerticalAlignment = xlCenter
            .MergeCells = True
            .Value = "Evento no." & i
            [COLOR=red].Cells(1, 1).Select[/COLOR]
 
            With Selection
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
           End With
Pero como te dije recién, está genial el código.
Gracias
 
Upvote 0
No compreendo...

Copiaste exactamente la ultima versión como escribi?

Cambiaste algo?

Yo hizo 1000 testes y funciona 100%

M.
 
Upvote 0
después de
SheetName = ActiveSheet.Name

Ponga essas tres líneas
Range("A:A").Clear
Range("B:B").Clear
Range("C:C").Clear

Espero qui solucione

M.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Y
  • Question
Pegar una lista de valores sólo en celdas visibles
Replies
1
Views
2K
DanteAmor
DanteAmor
I
  • Question
Direccionar de un rango a una celda especifica
Replies
0
Views
479
Inocente
I
D
  • Question
modificar el rango al codigo
Replies
2
Views
517
dragonfire33
D
D
  • Question
bordear celdas de acuerdo a la misma distancia
Replies
0
Views
654
dragonfire33
D
JIPM
  • Solved
Formato en Procedimiento Sub.
Replies
8
Views
789
DanteAmor
DanteAmor

Forum statistics

Threads
1,215,831
Messages
6,127,137
Members
449,361
Latest member
VBquery757

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top