¡¡¡ Ayuda !!!

03/12/2007 - 17:03 por Miguel | Informe spam
Buenas tardes,
He creado un formulario para la introducción de registros en una
determinada hoja excel, en mi caso denominada "Estadísticas". Este
formulario está formado por varios ComboBox y 4 TextBox.
Mi pregunta es la siguiente: ¿Qué modificación debo incluir en la
macro que os pongo a continuación, para que cuando introduzca un dato
determinado en el TextBox núm. 2 (Ej.: "XXXXXXXX", que siempre será el
mismo), todos los datos que, en ese momento, haya introducido en el
formulario se copien en otra hoja; Es decir, en una hoja distinta de
la denominada "Estadísticas"?

MACRO:

Dim n As Integer

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

Private Sub CommandButton2_Click()
DTPicker1 = Null
For n = 1 To 5: Me.Controls("textbox" & n) = "": Next
For n = 1 To 15: Me.Controls("combobox" & n).ListIndex = -1: Next
' Worksheets("listas").Visible = True
' Worksheets("listas").Select
' Worksheets("listas").Visible = False
Worksheets("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 = True
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

Sub Nombre_a_listas()
Dim nCol As Byte, Listados As Range, n As Byte, TitulosA, TitulosB
TitulosA = Array("Uni", "Doc", "Nac", "Mot", "Efe", "Jui")
TitulosB = Array("Unidad", "Documentos", "Nacionalidad", "Motivo",
"Efectos", "JUI")
On Error Resume Next
For n = LBound(TitulosA) To UBound(TitulosA):
Names(TitulosA(n)).Delete: Next
On Error GoTo 0
Range("a1:f1") = TitulosA
Set Listados = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
For nCol = 2 To 6
Set Listados = Union(Listados, Range(Cells(1, nCol), Cells(1,
nCol).End(xlDown)))
Next
Listados.Select
Selection.CreateNames True
Range("a1:f1") = TitulosB
Range("a1").Select
Set Listados = Nothing
End Sub


Muchas Gracias.
Miguel A.
 

Leer las respuestas

#1 Héctor Miguel
04/12/2007 - 07:05 | Informe spam
hola, Miguel !

He creado un formulario para la introduccion de registros en una... hoja... denominada "Estadísticas".
Este formulario esta formado por varios ComboBox y 4 TextBox.
Mi pregunta es la siguiente: Que modificacion debo incluir en la macro que os pongo a continuacion
para que cuando introduzca un dato determinado en el TextBox num. 2 (Ej.: "XXXXXXXX", que siempre sera el mismo)
todos los datos que, en ese momento, haya introducido en el formulario se copien en otra hoja
Es decir, en una hoja distinta de la denominada "Estadisticas"?



la fraccion de codigo que efectua el "pase" a tu hoja "estadisticas" es el bloque With...End With en el evento '_click' del commandbutton1
= With Worksheets("estadistica")
With .Range("a65536").End(xlUp).Offset(1)
.Value = .Row - 6
Range("registro") = .Value + 1
.Offset(, 1) = ComboBox1
.Offset(, 2) = TextBox1.Value
.Offset(, 3) = DTPicker1
.Offset(, 4) = TextBox2
For n = 2 To 14: .Offset(, n + 3) = Controls("combobox" & n): Next
.Offset(, 18) = TextBox3.Value
.Offset(, 19) = TextBox4.Value
.Offset(, 20) = ComboBox15
.Offset(, 21) = TextBox5
End With
End With
=
es la seccion de codigo que deberas "reproducir" en algun otro evento segun necesites...
(p.e.) al salir del textbox num 2 (otro commandbutton, o lo que sea) cambiando la primer linea:
de: -> With Worksheets("estadistica")
a: -> With Worksheets(textbox2)

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

__ el codigo expuesto __
Dim n As Integer
Private Sub CommandButton1_Click()
Dim Salir As Boolean
For n = 1 To 2: If Me.Controls("textbox" & n) = "" Then Salir = True: GoTo Verifica
Next
For n = 1 To 9: If Me.Controls("combobox" & n) = "" Then Salir = True: GoTo Verifica
Next
If IsNull(DTPicker1) Then Salir = True
Verifica:
If Salir Then MsgBox "FALTAN CASILLAS POR LLENAR !!!": Exit Sub
With Worksheets("estadistica")
With .Range("a65536").End(xlUp).Offset(1)
.Value = .Row - 6
Range("registro") = .Value + 1
.Offset(, 1) = ComboBox1
.Offset(, 2) = TextBox1.Value
.Offset(, 3) = DTPicker1
.Offset(, 4) = TextBox2
For n = 2 To 14: .Offset(, n + 3) = Controls("combobox" & n): Next
.Offset(, 18) = TextBox3.Value
.Offset(, 19) = TextBox4.Value
.Offset(, 20) = ComboBox15
.Offset(, 21) = TextBox5
End With
End With
End Sub

Private Sub CommandButton2_Click()
DTPicker1 = Null
For n = 1 To 5: Me.Controls("textbox" & n) = "": Next
For n = 1 To 15: Me.Controls("combobox" & n).ListIndex = -1: Next
' Worksheets("listas").Visible = True
' Worksheets("listas").Select
' Worksheets("listas").Visible = False
Worksheets("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 = True
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

Sub Nombre_a_listas()
Dim nCol As Byte, Listados As Range, n As Byte, TitulosA, TitulosB
TitulosA = Array("Uni", "Doc", "Nac", "Mot", "Efe", "Jui")
TitulosB = Array("Unidad", "Documentos", "Nacionalidad", "Motivo", "Efectos", "JUI")
On Error Resume Next
For n = LBound(TitulosA) To UBound(TitulosA): Names(TitulosA(n)).Delete: Next
On Error GoTo 0
Range("a1:f1") = TitulosA
Set Listados = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
For nCol = 2 To 6
Set Listados = Union(Listados, Range(Cells(1, nCol), Cells(1, nCol).End(xlDown)))
Next
Listados.Select
Selection.CreateNames True
Range("a1:f1") = TitulosB
Range("a1").Select
Set Listados = Nothing
End Sub

Preguntas similares