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
Re: Excel Userform to VB Userform
Welcome to VBForums :wave:
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!
Re: Excel Userform to VB Userform
Quote:
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
