• Lunes 18 de Noviembre de 2024, 04:27

Autor Tema:  Cambiar El Codigo  (Leído 2656 veces)

arielb

  • Moderador
  • ******
  • Mensajes: 771
  • Nacionalidad: pa
    • Ver Perfil
    • http://coder-pa.blogspot.com
Cambiar El Codigo
« en: Viernes 23 de Julio de 2004, 15:54 »
0
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
"Porque de tal manera amó Dios al mundo que dio a su hijo unigénito para que todo aquél que en él crea no se pierda mas tenga vida eterna"
Juan 3:16

http://coder-pa.blogspot.com

alexis salinas

  • Miembro activo
  • **
  • Mensajes: 32
    • Ver Perfil
Re: Cambiar El Codigo
« Respuesta #1 en: Viernes 23 de Julio de 2004, 18:20 »
0
que codigo????

Jose Arriagada

  • Miembro MUY activo
  • ***
  • Mensajes: 373
    • Ver Perfil
Re: Cambiar El Codigo
« Respuesta #2 en: Sábado 24 de Julio de 2004, 00:16 »
0
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.
El mensaje contiene 1 archivo adjunto. Debes ingresar o registrarte para poder verlo y descargarlo.

Jose Arriagada

  • Miembro MUY activo
  • ***
  • Mensajes: 373
    • Ver Perfil
Re: Cambiar El Codigo
« Respuesta #3 en: Sábado 24 de Julio de 2004, 00:19 »
0
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"

arielb

  • Moderador
  • ******
  • Mensajes: 771
  • Nacionalidad: pa
    • Ver Perfil
    • http://coder-pa.blogspot.com
Re: Cambiar El Codigo
« Respuesta #4 en: Sábado 24 de Julio de 2004, 19:22 »
0
Muchas gracias jose
"Porque de tal manera amó Dios al mundo que dio a su hijo unigénito para que todo aquél que en él crea no se pierda mas tenga vida eterna"
Juan 3:16

http://coder-pa.blogspot.com