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:
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?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
Thx in advance for your time.
Tunk




Reply With Quote