SoloCodigo
Programación General => Visual Basic 6.0 e inferiores => Mensaje iniciado por: arielb en Viernes 23 de Julio de 2004, 15:54
-
k ttal amigos tengo una duda, este codigo lo hice en el editor de visual basic osea en excell, se podrá pasar a basic este codigo?
Necesito me ayude porfavor y gracias de antemano.
Saludos y k Dios les bendiga,
Option Explicit
Private Sub CdmAceptar_Click()
ValidarCampos
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub Combopersonal_Change()
If Len(Combopersonal.Text) = 12 Then
TextSinicial.SetFocus
End If
End Sub
Private Sub CdmTerminar_Click()
Unload UserForm
End Sub
Private Sub TextFecha_Change()
If Len(TextFecha.Text) = 10 Then
End If
End Sub
Private Sub Textcantidad_Change()
If Len(Textcantidad.Value) = 7 Then
End If
End Sub
Private Sub Textcantidad_Enter()
Textcantidad.Value = (Textsecuenciaf.Value - TextSinicial)
End Sub
Private Sub Textestimadoh_Enter()
If TextMinuto.Value < TextMinuto2.Value Then
Textestimadoh.Value = (Texthora2.Value - Texthora.Value)
Else
Textestimadoh.Value = (Texthora2.Value - Texthora.Value) - 1
End If
End Sub
Private Sub Textestimadom_Enter()
If TextMinuto.Value < TextMinuto2.Value Then
Textestimadom.Value = (TextMinuto2.Value - TextMinuto.Value)
If Textestimadom.Value <= 9 Then
Textestimadom.Value = "0" & Textestimadom.Value
End If
Else
Textestimadom.Value = (60 - TextMinuto.Value) + TextMinuto2.Value
If Textestimadom.Value <= 9 Then
Textestimadom.Value = "0" & Textestimadom.Value
End If
End If
End Sub
Private Sub TextFecha_Enter()
TextFecha.Value = Date
End Sub
Private Sub TextMinuto_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextMinuto.Value <= 9 Then
TextMinuto.Value = "0" & TextMinuto.Value
End If
End Sub
Private Sub TextMinuto2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If TextMinuto2.Value <= 9 Then
TextMinuto2.Value = "0" & TextMinuto2.Value
End If
End Sub
Private Sub Textsecuenciaf_Change()
If Len(Textsecuenciaf.Value) = 7 Then
Textcantidad.SetFocus
End If
End Sub
Private Sub Textestimadom_Change()
If Len(Textestimadom.Value) = 7 Then
Textsecuenciaf.SetFocus
End If
End Sub
Private Sub Textestimadoh_Change()
If Len(Textestimadoh.Value) = 7 Then
Textestimadom.SetFocus
End If
End Sub
Private Sub TextMinuto2_Change()
If Len(TextMinuto2.Value) = 7 Then
Textestimadoh.SetFocus
End If
End Sub
Private Sub Texthora2_Change()
If Len(Texthora2.Value) = 3 Then
TextMinuto2.SetFocus
End If
End Sub
'aki se coloca la hora de inicio 1
Private Sub Texthora_Change()
If Len(Texthora.Value) = 3 Then
TextMinuto.SetFocus
End If
End Sub
'aki se coloca el minuto 1
Private Sub Textminuto_Change()
If Len(TextMinuto.Value) = 3 Then
Texthora2.SetFocus
End If
End Sub
Private Sub TextSinicial_Change()
If Len(TextSinicial.Text) = 12 Then
Texthora.SetFocus
End If
End Sub
Private Sub UserForm_initialize()
ActiveSheet.Range("b4").Activate
'Buscar la primera fila sin
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Private Sub ValidarCampos()
Dim Error As String
Dim ValorMensaje As Integer
Error = "Error en los datos del formulario"
If Len(Textsecuenciaf.Text) = 0 Then
ValorMensaje = MsgBox("El campo Numero de Secuencia inicial está vacio", _
vbOKOnly, Error)
TextSinicial.SetFocus
Else
If Len(Textsecuenciaf.Text) = 0 Then
ValorMensaje = MsgBox _
("El campo Secuencia final de serie está vacio", vbOKOnly, Error)
Textsecuenciaf.SetFocus
Else
With ActiveCell
.Value = Combopersonal
.Offset(0, 1).Value = TextSinicial
.Offset(0, 2).Value = Texthora
.Offset(0, 3).Value = ":"
.Offset(0, 4).Value = TextMinuto
.Offset(0, 5).Value = Texthora2
.Offset(0, 6).Value = ":"
.Offset(0, 7).Value = TextMinuto2
.Offset(0, 8).Value = Textestimadoh
.Offset(0, 9).Value = ":"
.Offset(0, 10).Value = Textestimadom
.Offset(0, 11).Value = Textsecuenciaf
.Offset(0, 12).Value = Textcantidad
.Offset(0, 13).Value = Combojornada
.Offset(0, 14).Value = TextFecha
End With
ActiveCell.Offset(1, 0).Activate
BorrarFormulario
End If
End If
End Sub
Private Sub BorrarFormulario()
Combopersonal.Text = ""
TextSinicial.Text = ""
Texthora.Text = ""
TextMinuto.Text = ""
Texthora2.Text = ""
TextMinuto2.Text = ""
Textestimadoh.Text = ""
Textestimadom.Text = ""
Textsecuenciaf.Text = ""
Textcantidad.Text = ""
Combojornada.Text = ""
TextFecha.Text = ""
End Sub
-
que codigo????
-
Si se puede. Ya que lo que acabas de poner es el script de excel para tratamiento de datos.
Si sabes visual basic, lo que te falta es enlazar EXCEL con tu aplicacion VB que haga lo que supone pusiste en el mensaje.
Ahora bien, como no todo es facil en esta vida, siempre hay que poner de nuestra cosecha, te envio un codigo, de como abrir un archivo excel, guardar datos.
Solo bastara que tu lo modifiques a tu gusto para que haga lo que desees, usando "Casi" exactamente el codigo scripts de excel.
Espero te resulte. A mi me han resultado sin problemas.
-
Adicionalmente te envio, una aplicacion mia, que lo que hace es tomar un archivo excel y lo modifica.
Si te fijas en las instrucciones, son las mismas del editor de VB en EXCEL (es decir, script) simplemente con algunas adaptaciones a VB.
Me.MousePointer = vbHourglass
Archivo = Trim(txtArchivo.Text)
Set xl = CreateObject("Excel.Application")
xl.Workbooks.Open Archivo
xl.Visible = False
xl.Worksheets("Hoja1").Activate
'Borra celdas de Pagina
xl.Worksheets("Hoja1").Range("J2") = ""
xl.Worksheets("Hoja1").Range("K2") = ""
'Elimina Fila 3 , 7, 9 y 10
xl.Rows("3:3").Select
Selection.Delete Shift:=xlUp
xl.Rows("7:7").Select
Selection.Delete Shift:=xlUp
xl.Rows("9:10").Select
Selection.Delete Shift:=xlUp
'Borra celdas con valor TP
xl.Worksheets("Hoja1").Range("B9") = ""
xl.Worksheets("Hoja1").Range("E9") = ""
'Cambia celda x RUT
xl.Worksheets("Hoja1").Range("C9") = "Rut"
'Elimina ultima columna DB
xl.Columns("L:L").Select
Selection.Delete Shift:=xlToLeft
'Recorre columna B moviendo los RUT
Espacios = 0
Sigue = 1
Fila = 9
While Sigue = 1
Fila = Fila + 1
sCeldaB = "B" & Fila
sValor = Trim(xl.Worksheets("Hoja1").Range(sCeldaB))
If Len(sValor) = 0 Then
Espacios = Espacios + 1
If Espacios = 10 Then
Sigue = 0
End If
Else
sCeldaC = "C" & Fila
If Es_Rut(sValor) = True Then
sValor = "'" & Editar_Rut(sValor, 2)
xl.Worksheets("Hoja1").Range(sCeldaC) = sValor
Else
xl.Worksheets("Hoja1").Range(sCeldaC) = ""
End If
xl.Worksheets("Hoja1").Range(sCeldaB) = ""
Espacios = 0
End If
Wend
'Elimina columna B
xl.Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
'Recorre columna D buscando Total y mueve la empresa
Espacios = 0
Sigue = 1
Fila = 9
While Sigue = 1
Fila = Fila + 1
sCeldaC = "C" & Fila
sValor = UCase(Trim(xl.Worksheets("Hoja1").Range(sCeldaC)))
If Len(sValor) = 0 Then
Espacios = Espacios + 1
If Espacios = 10 Then
Sigue = 0
End If
Else
If sValor = "TOTAL" Then
sCeldaD = "D" & Fila
sCeldaF = "F" & Fila
sEmpresa = Trim(xl.Worksheets("Hoja1").Range(sCeldaD))
xl.Worksheets("Hoja1").Range(sCeldaC) = "Total " & sEmpresa
Espacios = 0
End If
End If
Wend
'Eliminar columna D
xl.Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
'Cambia celda F9 a empty
xl.Worksheets("Hoja1").Range("F9") = ""
'Cambia celda G9 por Debitos
xl.Worksheets("Hoja1").Range("G9") = "Débitos"
'Recorre columna E eliminando la glosa NAC
Espacios = 0
Sigue = 1
Fila = 9
While Sigue = 1
Fila = Fila + 1
sCeldaE = "E" & Fila
sValor = UCase(Trim(xl.Worksheets("Hoja1").Range(sCeldaE)))
If Len(sValor) = 0 Then
Espacios = Espacios + 1
If Espacios = 10 Then
Sigue = 0
End If
Else
If sValor = "NAC" Then
xl.Worksheets("Hoja1").Range(sCeldaE) = ""
End If
Espacios = 0
End If
Wend
'Cambia el tipo de letra a toda la hoja
Columns("A:I").Select
Range("I6").Activate
Selection.Font.Name = "Times New Roman"
'Pone marco, centra y negrita a los titulos
Range("A9:I9").Select
Selection.HorizontalAlignment = xlCenter
Selection.Font.Bold = True
'Predefine la zona de encabezado
ActiveSheet.PageSetup.PrintTitleRows = "$1:$9"
ActiveSheet.PageSetup.RightHeader = "Página &P"
Me.MousePointer = vbDefault
ActiveWorkbook.SaveAs FileName:=Archivo
' xl.ActiveWorkbook.Close SaveChanges:=True
xl.Quit 'quit excel
Set xl = Nothing
MsgBox "Proceso terminado", vbInformation, "Resultado Transformación"
-
Muchas gracias jose