Results 1 to 3 of 3

Thread: Excel Userform to VB Userform

  1. #1

    Thread Starter
    New Member
    Join Date
    Jan 2012
    Posts
    1

    Excel Userform to VB Userform

    Hello everybody.

    I'm a VB noob and I'm sorry if what I'll ask is complete non sense.

    I have the following userform that I put together in Excel:

    Code:
    Private Sub btnCalculate_Click()
    Dim PrecioAdulto As Double
    Dim PrecioNinio As Double
    Dim PrecioTotal As Double
    Dim PrecioFee As Double
    Dim PrecioTotalAdultos As Double
    Dim PrecioTotalNinios As Double
    
    
    PrecioAdulto = 0
    PrecioNinio = 0
    PrecioTotal = 0
    PrecioFee = 0
    PrecioTotalAdultos = 0
    PrecioTotalNinios = 0
    
    
    
    If txtAdults.Value = 0 And txtChildren.Value = 0 Then
    MsgBox ("Ingrese Por lo menos una persona ya sea adulto o ninio")
    Exit Sub
    End If
    
    
    
    PrecioAdulto = BuscarPrecioAdulto(cboServices.Value)
    PrecioNinio = BuscarPrecioNinio(cboServices.Value)
    PrecioFee = ObtenerPrecioFee(cboServices.Value)
    PrecioComision = ObtenerPorcentajeComision(cboServices.Value)
    TotalAdultos = txtAdults.Value * 1
    TotalNinios = txtChildren.Value * 1
    PaxTotal = TotalAdultos + TotalNinios
    PrecioTotalAdultos = txtAdults.Value * PrecioAdulto
    PrecioTotalNinios = txtChildren.Value * PrecioNinio
    PrecioTotal = PrecioTotalAdultos + PrecioTotalNinios
    TipoDeCambio = lblTipodeCambio.Caption
    PrecioTotalMXN = PrecioTotal * TipoDeCambio
    Comision = PrecioTotalMXN * PrecioComision
    PrecioNeto1 = PrecioTotalMXN - Comision
    PrecioNeto2 = PrecioNeto1 - TotalServicio
    Servicios = PaxTotal
    TotalServicio = PaxTotal * PrecioFee
    
    
    lblPVP.Caption = Format(PrecioTotalMXN, "currency")
    lblBAseComUnit.Caption = Format((PrecioNeto1 - TotalServicio) / 1.11, "currency")
    lblServicefee.Caption = Format((PaxTotal * PrecioFee), "currency")
    lblMarkup.Caption = Format((Comision / 1.11), "currency")
    
    End Sub
    
    Private Sub btnReservaAnticipada_Click()
    Dim PrecioAdulto As Double
    Dim PrecioNinio As Double
    Dim PrecioTotal As Double
    Dim PrecioFee As Double
    Dim PrecioTotalAdultos As Double
    Dim PrecioTotalNinios As Double
    
    
    PrecioAdulto = 0
    PrecioNinio = 0
    PrecioTotal = 0
    PrecioFee = 0
    PrecioTotalAdultos = 0
    PrecioTotalNinios = 0
    
    
    
    If txtAdults.Value = 0 And txtChildren.Value = 0 Then
    MsgBox ("Ingrese Por lo menos una persona ya sea adulto o ninio")
    Exit Sub
    End If
    
    
    
    PrecioAdulto = BuscarPrecioAdulto(cboServices.Value)
    PrecioNinio = BuscarPrecioNinio(cboServices.Value)
    PrecioFee = ObtenerPrecioFee(cboServices.Value)
    PrecioComision = ObtenerPorcentajeComision(cboServices.Value)
    TotalAdultos = txtAdults.Value * 1
    TotalNinios = txtChildren.Value * 1
    PaxTotal = TotalAdultos + TotalNinios
    PrecioTotalAdultos = txtAdults.Value * PrecioAdulto
    PrecioTotalNinios = txtChildren.Value * PrecioNinio
    PrecioTotal = PrecioTotalAdultos + PrecioTotalNinios
    TipoDeCambio = lblTipodeCambio.Caption
    PrecioTotalMXN = PrecioTotal * TipoDeCambio
    Comision = PrecioTotalMXN * PrecioComision
    PrecioNeto1 = PrecioTotalMXN - Comision
    PrecioNeto2 = PrecioNeto1 - TotalServicio
    Servicios = PaxTotal
    TotalServicio = PaxTotal * PrecioFee
    
    
    lblPVP.Caption = Format(PrecioTotalMXN, "currency")
    lblBAseComUnit.Caption = Format((PrecioNeto1 - TotalServicio) / 1.11, "currency")
    lblServicefee.Caption = Format((PaxTotal * PrecioFee), "currency")
    lblMarkup.Caption = Format((Comision / 1.11), "currency")
    
    End Sub
    
    
    Sub LimpiaContenedores()
    CargaXcaret.cboServices.Value = ""
    CargaXcaret.lblBAseComUnit.Caption = "$"
    CargaXcaret.lblMarkup.Caption = "$"
    CargaXcaret.lblPVP.Caption = "$"
    CargaXcaret.lblServicefee.Caption = "$"
    CargaXcaret.txtAdults.Value = 0
    CargaXcaret.txtChildren.Value = 0
    
    
    End Sub
    
    Private Sub btnCerrarAplication_Click()
    Application.DisplayAlerts = False
        Unload Me
    Application.Workbooks("Experiencias Xcaret 2012 - 13.20 USD").Activate
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    End Sub
    
    Private Sub cmdLimpiar_Click()
     Call LimpiaContenedores
    End Sub
    
    
    Private Sub UserForm_Initialize()
    
        lblTipodeCambio.Caption = Format(Sheets("Lista de Precios").Range("H14"), "currency")
        
    Dim Celda As Range
    Dim UltimaFilaPrecio As Integer
    Dim Agrega As String
    Application.ScreenUpdating = False
        
        UltimaFilaPrecio = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
        For Each Celda In Sheets("Lista de Precios").Range("A3:A" & UltimaFilaPrecio).Cells
            'agregara todos los valores que sean diferentes a ""( es decir que no esten vacios)
            If Celda <> "" Then
                Agrega = Celda
                cboServices.AddItem Celda
            Else
            End If
        Next
        
    End Sub
    
    Private Sub Workbook_Xcaret_Prices_Open()
        CargaXcaret.Show 'Where "MYForm" is the name of your form.
    End Sub
    
    
    Private Function BuscarPrecioAdulto(ValorBuscar As String) As Double
    Application.ScreenUpdating = False
    Dim Celda As Range
    Dim RangeFind As Range
    Dim UltimaFila As Integer
    Dim FilaEncontrado
    UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
        Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
            For Each Celda In RangeFind
                If Celda.Value = ValorBuscar Then
                    FilaEncontrado = Celda.Row
                Else
                End If
            Next Celda
        BuscarPrecioAdulto = Sheets("Lista de Precios").Cells(FilaEncontrado, 2)
    Application.ScreenUpdating = True
    End Function
    
    
    Private Function BuscarPrecioNinio(ValorBuscar As String) As Double
    Application.ScreenUpdating = False
    Dim Celda As Range
    Dim RangeFind As Range
    Dim UltimaFila As Integer
    Dim FilaEncontrado
    UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
        Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
            For Each Celda In RangeFind
                If Celda.Value = ValorBuscar Then
                    FilaEncontrado = Celda.Row
                Else
                End If
            Next Celda
        BuscarPrecioNinio = Sheets("Lista de Precios").Cells(FilaEncontrado, 3)
    Application.ScreenUpdating = True
    End Function
    
    Private Function ObtenerPrecioFee(ValorBuscar As String) As Double
    Application.ScreenUpdating = False
    Dim Celda As Range
    Dim RangeFind As Range
    Dim UltimaFila As Integer
    Dim FilaEncontrado
    UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
        Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
            For Each Celda In RangeFind
                If Celda.Value = ValorBuscar Then
                    FilaEncontrado = Celda.Row
                Else
                End If
            Next Celda
        ObtenerPrecioFee = Sheets("Lista de Precios").Cells(FilaEncontrado, 4)
    Application.ScreenUpdating = True
    End Function
    
    
    Private Function ObtenerPorcentajeComision(ValorBuscar As String) As Double
    Application.ScreenUpdating = False
    Dim Celda As Range
    Dim RangeFind As Range
    Dim UltimaFila As Integer
    Dim FilaEncontrado
    UltimaFila = Sheets("Lista de Precios").Cells(Application.Rows.Count, 1).End(xlUp).Row
        Set RangeFind = Sheets("Lista de Precios").Range("A3:A" & UltimaFila).Cells
            For Each Celda In RangeFind
                If Celda.Value = ValorBuscar Then
                    FilaEncontrado = Celda.Row
                Else
                End If
            Next Celda
        ObtenerPorcentajeComision = Sheets("Lista de Precios").Cells(FilaEncontrado, 5)
    Application.ScreenUpdating = True
    End Function
    
    
    
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
    MsgBox "Use el boton cerrar del formulario", vbInformation, "Imposible Cerrar"
    Cancel = 1
    CloseMode = 1
    End If
    End Sub
    This is obviously based on an Excel Worksheet, is it possible to migrate this to an independent VB project which includes all the prices that I need but does not need Excel to open / close?

    Thx in advance for your time.

    Tunk

  2. #2
    I don't do your homework! opus's Avatar
    Join Date
    Jun 2000
    Location
    Good Old Europe
    Posts
    3,863

    Re: Excel Userform to VB Userform

    Welcome to VBForums

    Userorms from VBA(as in Excel) are Forms in VB, the syntax is nearly the same.
    Create the form in VB and try to paste in the used code from VBA.
    However each reference to the actual Excel-File needs to be treated differently AND you will NOT be able to get any information that you take from that file if you do not open that file!
    You're welcome to rate this post!
    If your problem is solved, please use the Mark thread as resolved button


    Wait, I'm too old to hurry!

  3. #3
    PowerPoster
    Join Date
    Dec 2004
    Posts
    25,618

    Re: Excel Userform to VB Userform

    is it possible to migrate this to an independent VB project which includes all the prices that I need but does not need Excel to open / close?
    it would require you to have vb6 or vb.net
    you could store you data elsewhere to an excel sheet, so that you would not be dependent on excel
    choices could be text file of some type or a database
    code in vb6 would be almost the same, where as vb.net would require some conversion, but as you are only learning, better to learn the new version (vb.net) the express edition is free to download and use, not the case with vb6 which you would have to find and purchase some where
    i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
    Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next

    dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part

    come back and mark your original post as resolved if your problem is fixed
    pete

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width