"Arreglito" de macro

07/11/2007 - 18:06 por Miguel | Informe spam

Tengo un formulario con varios ComboBox y TextBox que me copian los
datos en una hoja concreta "Estadisticas". El problema es que cuando
estoy en la hoja "Formulario" tengo incrustrado un control "Ir a
formulario" que, al activarlo, me abre el formulario en esta hoja.
Todo perfecto y según lo que quiero que haga. El problema es que hasta
que lo abre, durante unos segundos, se queda en pantalla la hoja
"Listas" que es de donde toman los datos los diferentes ComboBox de
los que consta el formulario. Os envío los códigos por si es posible
"pulirlos" un poco para ajustar este problemilla, que no queda muy
bien que digamos, por si podemos evitar que se mantenga en pantalla
hasta que se abre el formulario. O cuaquier otra mejora o modificación
que estimés necesaria.

Muchas gracias,

Un saludo,

M. Ángel

CÓDIGO:

Private Sub CommandButton1_Click()
If TextBox1.Value = "" Or TextBox1.Value = "" Or DTPicker1.Value = ""
Or ComboBox1.Value = "" _
Or TextBox2.Value = "" Or ComboBox3.Value = "" Or ComboBox2.Value = ""
Or ComboBox4.Value = "" Or ComboBox5.Value = "" Or ComboBox6.Value "" Or ComboBox7.Value = "" Or ComboBox8.Value = "" Or ComboBox9.Value
= "" Then
MsgBox ("FALTAN CASILLAS POR LLENAR")
Exit Sub
End If
Sheets("ESTADISTICA").Visible = True
Sheets("estadistica").Select

contar = Application.WorksheetFunction.CountA(Range("a2:a50000"))
Cells(contar + 6, 1) = contar + 0
Range("registro") = contar + 1

Cells(contar + 6, 2) = ComboBox1.Value
Cells(contar + 6, 3) = TextBox1.Value
Cells(contar + 6, 4) = DTPicker1.Value
Cells(contar + 6, 5) = TextBox2.Value
Cells(contar + 6, 6) = ComboBox2.Value
Cells(contar + 6, 7) = ComboBox3.Value
Cells(contar + 6, 8) = ComboBox4.Value
Cells(contar + 6, 9) = ComboBox5.Value
Cells(contar + 6, 10) = ComboBox6.Value
Cells(contar + 6, 11) = ComboBox7.Value
Cells(contar + 6, 12) = ComboBox8.Value
Cells(contar + 6, 13) = ComboBox9.Value
Cells(contar + 6, 14) = ComboBox10.Value
Cells(contar + 6, 15) = ComboBox11.Value
Cells(contar + 6, 16) = ComboBox12.Value
Cells(contar + 6, 17) = ComboBox13.Value
Cells(contar + 6, 18) = ComboBox14.Value
Cells(contar + 6, 19) = TextBox3.Value
Cells(contar + 6, 20) = TextBox4.Value
Cells(contar + 6, 21) = ComboBox15.Value
Cells(contar + 6, 22) = TextBox5.Value

Sheets("ESTADISTICA").Visible = False
Sheets("Formulario").Select
End Sub

Private Sub CommandButton2_Click()
Dim nal As Single
Dim und As Single
Dim doc As Single
Dim mot As Single
Dim efe As Single
Dim jui As Single
Sheets("LISTAS").Visible = True
Sheets("listas").Select

ComboBox1.Clear
TextBox1 = ""
DTPicker1 = Clear
TextBox2 = ""
ComboBox2.Clear
ComboBox3.Clear
ComboBox4.Clear
ComboBox5.Clear
ComboBox6.Clear
ComboBox7.Clear
ComboBox8.Clear
ComboBox9.Clear
ComboBox10.Clear
ComboBox11.Clear
ComboBox12.Clear
ComboBox13.Clear
ComboBox14.Clear
TextBox3 = ""
TextBox4 = ""
ComboBox15.Clear
TextBox5 = ""
Sheets("LISTAS").Visible = True
Sheets("listas").Select

und = Application.WorksheetFunction.CountA(Range("a2:a50000"))
doc = Application.WorksheetFunction.CountA(Range("b2:b50000"))
nal = Application.WorksheetFunction.CountA(Range("c2:c50000"))
mot = Application.WorksheetFunction.CountA(Range("d2:d50000"))
efe = Application.WorksheetFunction.CountA(Range("e2:e50000"))
jui = Application.WorksheetFunction.CountA(Range("f2:f50000"))

For und1 = 2 To und + 1
ComboBox1.AddItem Cells(und1, 1).Value
Next

For doc1 = 2 To doc + 1
ComboBox4.AddItem Cells(doc1, 2).Value
ComboBox6.AddItem Cells(doc1, 2).Value
ComboBox8.AddItem Cells(doc1, 2).Value
Next

For nal1 = 2 To nal + 1
ComboBox3.AddItem Cells(nal1, 3).Value
ComboBox5.AddItem Cells(nal1, 3).Value
ComboBox7.AddItem Cells(nal1, 3).Value
ComboBox9.AddItem Cells(nal1, 3).Value
Next

For mot1 = 2 To mot + 1
ComboBox2.AddItem Cells(mot1, 4).Value
Next

For efe1 = 2 To und + 1
ComboBox10.AddItem Cells(efe1, 5).Value
ComboBox11.AddItem Cells(efe1, 5).Value
ComboBox12.AddItem Cells(efe1, 5).Value
ComboBox13.AddItem Cells(efe1, 5).Value
ComboBox14.AddItem Cells(efe1, 5).Value
Next

For jui1 = 2 To und + 1
ComboBox15.AddItem Cells(jui1, 6).Value
Next
Sheets("LISTAS").Visible = False
Sheets("Formulario").Select
End Sub

Private Sub CommandButton3_Click()
Unload Me
End Sub

Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal
Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
Calendar1.Today "actualiza o muestra la fecha actual
End Sub

Private Sub OptionButton1_Click()
If OptionButton1.Value = True Then
Sheets("listas").Visible = True
Sheets("ESTADISTICA").Visible = False
Sheets("TABLA").Visible = False
Sheets("listas").Select
End If
Unload Me
End Sub

Private Sub OptionButton2_Click()
If OptionButton2.Value = True Then
Sheets("ESTADISTICA").Visible = True
Sheets("LISTAS").Visible = False
Sheets("TABLA").Visible = False
Sheets("ESTADISTICA").Select
End If
Unload Me
End Sub

Private Sub OptionButton3_Click()
If OptionButton3.Value = True Then
Sheets("TABLA").Visible = True
Sheets("LISTAS").Visible = False
Sheets("ESTADISTICA").Visible = False
Sheets("TABLA").Select
End If
Unload Me
End Sub

Private Sub UserForm_Initialize()
Dim nal As Single
Dim und As Single
Dim doc As Single
Dim mot As Single
Dim efe As Single
Dim jui As Single
Sheets("listas").Visible = True
Sheets("listas").Select

und = Application.WorksheetFunction.CountA(Range("a2:a50000"))
doc = Application.WorksheetFunction.CountA(Range("b2:b50000"))
nal = Application.WorksheetFunction.CountA(Range("c2:c50000"))
mot = Application.WorksheetFunction.CountA(Range("d2:d50000"))
efe = Application.WorksheetFunction.CountA(Range("e2:e50000"))
jui = Application.WorksheetFunction.CountA(Range("f2:f50000"))

For und1 = 2 To und + 1
Celda = Cells(und1, 1).Value
ComboBox1.RowSource = "A2:" & [A2].End(xlDown).Address
Next

For doc1 = 2 To doc + 1
Celda = Cells(doc1, 2).Value
ComboBox4.RowSource = "B2:" & [B2].End(xlDown).Address
ComboBox6.RowSource = "B2:" & [B2].End(xlDown).Address
ComboBox8.RowSource = "B2:" & [B2].End(xlDown).Address
Next

For nal1 = 2 To nal + 1
Celda = Cells(nal1, 3).Value
ComboBox3.RowSource = "C2:" & [C2].End(xlDown).Address
ComboBox5.RowSource = "C2:" & [C2].End(xlDown).Address
ComboBox7.RowSource = "C2:" & [C2].End(xlDown).Address
ComboBox9.RowSource = "C2:" & [C2].End(xlDown).Address
Next

For mot1 = 2 To mot + 1
Celda = Cells(mot1, 4).Value
ComboBox2.RowSource = "D2:" & [D2].End(xlDown).Address
Next

For efe1 = 2 To nal + 1
Celda = Cells(efe1, 5).Value
ComboBox10.RowSource = "E2:" & [E2].End(xlDown).Address
ComboBox11.RowSource = "E2:" & [E2].End(xlDown).Address
ComboBox12.RowSource = "E2:" & [E2].End(xlDown).Address
ComboBox13.RowSource = "E2:" & [E2].End(xlDown).Address
ComboBox14.RowSource = "E2:" & [E2].End(xlDown).Address
Next

For jui1 = 2 To und + 1
Celda = Cells(jui1, 6).Value
ComboBox15.RowSource = "F2:" & [F2].End(xlDown).Address
Next
Sheets("inicio").Visible = True
Sheets("listas").Visible = False
Sheets("Tabla").Visible = False
Sheets("Estadistica").Visible = False
Sheets("Gráfico1").Visible = False
Sheets("Formulario").Select
End Sub

MÓDULO 1:

Sub auto_open()
Sheets("Inicio").Activate
Sheets("listas").Visible = True
Sheets("Gráfico1").Visible = True
Sheets("Tabla").Visible = True
Sheets("Estadistica").Visible = True
End Sub

Sub abrir()
Sheets("Formulario").Select
principal.Show
End Sub

Sub actualiza()

"Range("a10").Select
ActiveSheet.PivotTables("Tabla dinámica1").PivotCache.Refresh
End Sub

Siga el debate

9 respuestas

Tengo una respuesta

Preguntas similare

"Arreglito" de macro 2

Leer las respuestas

#1 Ivan

07/11/2007 - 18:18 | Informe spam

hola Miguel,

a1ª vista lo que se me ocurre es que NO muestres la hoja listas. No
hace falta que este visible para trabajar con ella (excepto, claro
esta si quieres verla). Tampoco es necesario que muestres ninguna que
no quieras ver por algo en especial. Ni tampoco que las actives ni/o
selecciones. Podras trabajar con ellas perfectamente solo con hacer
mencion a ellas por su nombre, pej. asi =>

[Worksheets("Nombre_ de_ la_hoja").tal_propiedad.etc...]

en cuanto al codigo, 'uufff'...

un saludo y a ver si hay suerte

un saludo
Ivan

Responder a este mensaje

#2 Héctor Miguel

08/11/2007 - 07:52 | Informe spam

hola, Miguel !

Tengo un formulario con varios ComboBox y TextBox que me copian los datos en una hoja concreta "Estadisticas".
El problema es que cuando estoy en la hoja "Formulario" tengo incrustrado un control "Ir a formulario" que, al activarlo
me abre el formulario en esta hoja. Todo perfecto y segun lo que quiero que haga.
El problema es que hasta que lo abre, durante unos segundos, se queda en pantalla la hoja "Listas"
que es de donde toman los datos los diferentes ComboBox de los que consta el formulario.
Os envio los codigos por si es posible "pulirlos" un poco para ajustar este problemilla, que no queda muy bien que digamos
por si podemos evitar que se mantenga en pantalla hasta que se abre el formulario.
O cuaquier otra mejora o modificacion que estimes necesaria...

comprenderas que no me ha sido posible probar "en igualdad de circunstancias" a tu caso real (pero)...
es probable que sustituyendo los codigos en tus procedimientos '_initialize' y a los commandbuttons 1 y 2
y agregando un procedimiento "comun" para el re/llenado de los combos obtendrias +/- lo mismo con alguna mejora en el rendimiento -?-

haz algunas pruebas (obviamente sobre copia de tus archivos reales) y...
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Dim n As Byte

Private Sub UserForm_Initialize()
Rellena_Combos
End Sub

Private Sub CommandButton1_Click()
Dim Salir As Boolean
For n = 1 To 2: If Controls("textbox" & n) = "" Then Salir = True: GoTo Verifica
Next
For n = 1 To 9: If Controls("combobox" & n) = "" Then Salir = True: GoTo Verifica
Next
If DTPicker1 = "" Then Salir = True
Verifica:
If Salir Then MsgBox "Faltan cosillas por llenar !!!": Exit Sub
With Worksheets("estadistica").Range("a2").End(xlDown).Offset(6)
.Value = .Row - 6
Range("registro") = .Value + 1
.Offset(, 1) = ComboBox1
.Offset(, 2) = TextBox1
.Offset(, 3) = DTPicker1
.Offset(, 4) = TextBox2
For n = 2 To 14: .Offset(, n + 3) = Controls("combobox" & n): Next
.Offset(, 18) = TextBox3
.Offset(, 19) = TextBox4
.Offset(, 20) = ComboBox15
.Offset(, 21) = TextBox5
End With
End Sub

Private Sub CommandButton2_Click()
DTPicker1 = Clear
For n = 1 To 5: Controls("textbox" & n) = "": Next
For n = 1 To 15: Controls("combobox" & n).Clear: Next
Rellena_Combos
End Sub

Private Sub Rellena_Combos()
With Worksheets("listas").Range(.[a2], .[a2].End(xlDown))
ComboBox1.RowSource = .Address
For n = 4 To 8 Step 2: Controls("combobox" & n).RowSource = .Offset(, 1).Address: Next
For n = 3 To 9 Step 2: Controls("combobox" & n).RowSource = .Offset(, 2).Address: Next
ComboBox2.RowSource = .Offset(, 3).Address
For n = 10 To 14: Controls("combobox" & n).RowSource = .Offset(, 4).Address: Next
ComboBox15.RowSource = .Offset(, 5).Address
End With
End Sub

Responder a este mensaje

#3 Miguel

08/11/2007 - 11:28 | Informe spam

On 8 nov, 07:52, "Héctor Miguel"
wrote:

hola, Miguel !

> Tengo un formulario con varios ComboBox y TextBox que me copian los datos en una hoja concreta "Estadisticas".
> El problema es que cuando estoy en la hoja "Formulario" tengo incrustrado un control "Ir a formulario" que, al activarlo
> me abre el formulario en esta hoja. Todo perfecto y segun lo que quiero que haga.
> El problema es que hasta que lo abre, durante unos segundos, se queda en pantalla la hoja "Listas"
> que es de donde toman los datos los diferentes ComboBox de los que consta el formulario.
> Os envio los codigos por si es posible "pulirlos" un poco para ajustar este problemilla, que no queda muy bien que digamos
> por si podemos evitar que se mantenga en pantalla hasta que se abre el formulario.
> O cuaquier otra mejora o modificacion que estimes necesaria...

comprenderas que no me ha sido posible probar "en igualdad de circunstancias" a tu caso real (pero)...
es probable que sustituyendo los codigos en tus procedimientos '_initialize' y a los commandbuttons 1 y 2
y agregando un procedimiento "comun" para el re/llenado de los combos obtendrias +/- lo mismo con alguna mejora en el rendimiento -?-

haz algunas pruebas (obviamente sobre copia de tus archivos reales) y...
si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Dim n As Byte

Private Sub UserForm_Initialize()
Rellena_Combos
End Sub

Private Sub CommandButton1_Click()
Dim Salir As Boolean
For n = 1 To 2: If Controls("textbox" & n) = "" Then Salir = True: GoTo Verifica
Next
For n = 1 To 9: If Controls("combobox" & n) = "" Then Salir = True: GoTo Verifica
Next
If DTPicker1 = "" Then Salir = True
Verifica:
If Salir Then MsgBox "Faltan cosillas por llenar !!!": Exit Sub
With Worksheets("estadistica").Range("a2").End(xlDown).Offset(6)
.Value = .Row - 6
Range("registro") = .Value + 1
.Offset(, 1) = ComboBox1
.Offset(, 2) = TextBox1
.Offset(, 3) = DTPicker1
.Offset(, 4) = TextBox2
For n = 2 To 14: .Offset(, n + 3) = Controls("combobox" & n): Next
.Offset(, 18) = TextBox3
.Offset(, 19) = TextBox4
.Offset(, 20) = ComboBox15
.Offset(, 21) = TextBox5
End With
End Sub

Private Sub CommandButton2_Click()
DTPicker1 = Clear
For n = 1 To 5: Controls("textbox" & n) = "": Next
For n = 1 To 15: Controls("combobox" & n).Clear: Next
Rellena_Combos
End Sub

Private Sub Rellena_Combos()
With Worksheets("listas").Range(.[a2], .[a2].End(xlDown))
ComboBox1.RowSource = .Address
For n = 4 To 8 Step 2: Controls("combobox" & n).RowSource = .Offset(, 1).Address: Next
For n = 3 To 9 Step 2: Controls("combobox" & n).RowSource = .Offset(, 2).Address: Next
ComboBox2.RowSource = .Offset(, 3).Address
For n = 10 To 14: Controls("combobox" & n).RowSource = .Offset(, 4).Address: Next
ComboBox15.RowSource = .Offset(, 5).Address
End With
End Sub

En primer lugar, darte las gracias por tu contestación. He estado
realizando pruebas con el código que me envías, pero al iniciar el
control "Ir a formulario", desde la hoja "Formulario", siempre me da
error de compilación, referencia no válida o sin calificar, marcando
el código que me has facilitado para rellenar_combos.
Quizás el problema esté aquí: With Worksheets("listas").Range(.[a2], .
[a2].End(xlDown)), ¿puede ser por el rango a2?
¿Dónde colocas los rangos de las listas, donde se encuentran und, doc,
nal, mot, efe y jui; de donde toman los datos los Combox?
A ver si lo conseguimos.
Un saludo,
M. Ángel

Responder a este mensaje

#4 Héctor Miguel

08/11/2007 - 17:46 | Informe spam

hola, Miguel !

... realizando pruebas... al iniciar el control "Ir a formulario", desde la hoja "Formulario"
siempre me da error de compilacion, referencia no valida o sin calificar
marcando l código que me has facilitado para rellenar_combos.
Quizas el problema este aqui: With Worksheets("listas").Range(.[a2], .[a2].End(xlDown))
puede ser por el rango a2?
Donde colocas los rangos de las listas, donde se encuentran und, doc, nal, mot, efe y jui
de donde toman los datos los Combox?...

mas bien, por no haber corrido pruebas sobre un lstado con datos como los reales...
lo que le "sobra" a esa linea es el punto antes del corchete -> .[
prueba cambiando a: -> With Worksheets("listas").Range([a2], [a2].End(xlDown))

(en principio) ya no seria necesario des/re/ocultar ni mostrar las hojas que necesites mantener ocultas
ni las variables que tenias definidas, ya que las listas se toman con Offsets y los combos estan por ciclos/bucles
(revisa el codigo, y ya que lo pongamos a funcionar)...

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

Responder a este mensaje

#5 Miguel

08/11/2007 - 18:19 | Informe spam

On 8 nov, 17:46, "Héctor Miguel"
wrote:

hola, Miguel !

> ... realizando pruebas... al iniciar el control "Ir a formulario", desde la hoja "Formulario"
> siempre me da error de compilacion, referencia no valida o sin calificar
> marcando l código que me has facilitado para rellenar_combos.
> Quizas el problema este aqui: With Worksheets("listas").Range(.[a2], .[a2].End(xlDown))
> puede ser por el rango a2?
> Donde colocas los rangos de las listas, donde se encuentran und, doc, nal, mot, efe y jui
> de donde toman los datos los Combox?...

mas bien, por no haber corrido pruebas sobre un lstado con datos como los reales...
lo que le "sobra" a esa linea es el punto antes del corchete -> .[
prueba cambiando a: -> With Worksheets("listas").Range([a2], [a2].End(xlDown))

(en principio) ya no seria necesario des/re/ocultar ni mostrar las hojas que necesites mantener ocultas
ni las variables que tenias definidas, ya que las listas se toman con Offsets y los combos estan por ciclos/bucles
(revisa el codigo, y ya que lo pongamos a funcionar)...

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector

De nuevo, muchas gracias. Parece haberse solucionado ese problema.
Ahora, lo que sucede es que al introducir estos nuevos códigos, nos
causa incompatibilidad con el código del módulo 1 que abre el
Formulario, concretamente con "principal.Show". La cuestión es que si
lo elimino, no se abre el formulario. ¿Qué se te ocurre?
Un saludo,
M. Ángel
MÓDULO 1:

Sub abrir()
Sheets("Formulario").Select
principal.Show
End Sub

Responder a este mensaje

Ads by Google

Hacer una preguntaSiguiente

Tengo una respuesta

Busqueda sugerida