Aquí tienes el código para Visual Basic de la aplicación de ejemplo del artículo Error al guardar datos decimales: El valor del parámetro ‘xxx’ está fuera del intervalo.
Nota:
Si buscabas el código para C# está en este otro enlace:
Error al guardar datos decimales – El código para C#.
Cuando lo tenga publicado, te pondré el enlace para descargar la solución de Visual Studio 2017 tanto para VB como para C#.
El código de Visual Basic .NET
'------------------------------------------------------------------------------ ' Ejemplo para el error de asignar a decimal(4,4) (07/Dic/18) ' ' (c) Guillermo (elGuille) Som, 2018 '------------------------------------------------------------------------------ Option Strict On Option Infer On Imports System 'Imports System.Data Imports System.Data.SqlClient Imports System.Text Public Class Form1 '-------------------------------------------------------------------------- ' Los campos para acceder a la base de datos '-------------------------------------------------------------------------- ''' <summary> ''' El usuario para acceder a la base de datos de SQL Server.<br /> ''' Si es una cadena vacía se usará la seguridad integrada de Windows. ''' </summary> Private userDb As String = "UsuarioErrDec" ''' <summary> ''' El password del usuario que accede a la base de datos de SQL Server ''' </summary> Private passwordDB As String = "123456" ''' <summary> ''' El servidor donde está la base de datos.<br /> ''' Normalmente será .\SQLEXPRESS o (local) ''' </summary> Private serverName As String = ".\SQLEXPRESS" ' "(local)" ''' <summary> ''' El nombre de la base de datos de SQL Server ''' </summary> Private databaseName As String = "ErrorDecimal" ''' <summary> ''' Devuelve la cadena de conexión a la base de datos de SQL Server<br /> ''' Si el usuario es una cadena vacía, se usará la seguridad integrada de Windows ''' </summary> Private ReadOnly Property ConnectionString As String Get With New SqlConnectionStringBuilder .DataSource = serverName .InitialCatalog = databaseName If String.IsNullOrWhiteSpace(userDb) Then .IntegratedSecurity = True Else .UserID = userDb .Password = passwordDB End If Return .ConnectionString End With End Get End Property '-------------------------------------------------------------------------- ' Añadir un valor a las tablas '-------------------------------------------------------------------------- Private Function AñadirMiTabla1(valor As Decimal) As (hayError As Boolean, msg As String) Dim sel = "INSERT INTO MiTabla1 (Decimal_4_4) VALUES (@Decimal_4_4)" Dim retVal = (hayError:=False, msg:="") Dim sCon = ConnectionString Using con As New SqlConnection(sCon) Dim cmd As New SqlCommand(sel, con) cmd.Parameters.AddWithValue("@Decimal_4_4", valor) con.Open() Try Dim ret = CInt(cmd.ExecuteNonQuery()) 'Dim ret = CInt(cmd.ExecuteScalar()) retVal.hayError = (ret < 1) retVal.msg = "Todo OK. cmd.ExecuteNonQuery() = " & ret.ToString Catch ex As Exception retVal.msg = ex.Message retVal.hayError = True End Try con.Close() End Using Return retVal End Function Private Function AñadirMiTabla2(valores() As Decimal) As (hayError As Boolean, msg As String) Dim sel = "INSERT INTO MiTabla2 (Decimal_6_4, Decimal_18_6) VALUES (@Decimal_6_4, @Decimal_18_6)" Dim retVal = (hayError:=False, msg:="") Dim sCon = ConnectionString Using con As New SqlConnection(sCon) Dim cmd As New SqlCommand(sel, con) cmd.Parameters.AddWithValue("@Decimal_6_4", valores(0)) cmd.Parameters.AddWithValue("@Decimal_18_6", valores(1)) con.Open() Try Dim ret = CInt(cmd.ExecuteNonQuery()) retVal.hayError = (ret < 1) retVal.msg = "Todo OK. cmd.ExecuteNonQuery() = " & ret.ToString Catch ex As Exception retVal.msg = ex.Message retVal.hayError = True End Try con.Close() End Using Return retVal End Function Private Function leerMiTabla(tabla As String) As String Dim sel = "SELECT * FROM " & tabla Dim retVal = "" Dim sCon = ConnectionString Using con As New SqlConnection(sCon) Dim cmd As New SqlCommand(sel, con) con.Open() Try Dim ret = cmd.ExecuteReader Dim sb As New StringBuilder While ret.Read() sb.AppendLine(String.Format("{0} = {1}", ret.GetName(0), ret(0))) If ret.FieldCount > 1 Then sb.AppendLine(String.Format("{0} = {1}", ret.GetName(1), ret(1))) End If End While retVal = sb.ToString Catch ex As Exception retVal = "ERROR: " & ex.Message End Try con.Close() End Using Return retVal End Function '-------------------------------------------------------------------------- ' Para aceptar la coma como decimal en las cajas numéricas '-------------------------------------------------------------------------- ''' <summary> ''' El separador de decimales para los campos numéricos ''' </summary> Private Const SeparadorDecimal As String = "," ''' <summary> ''' Para indicar qué tecla "decimal" no se debe admitir ''' </summary> Private Const NoSeparadorDecimal As String = "." ''' <summary> ''' Comprobar si se aceptan las teclas en una caja de texto. ''' En la pulsación de los controles numéricos ''' aceptar solo los caracteres numéricos, ''' el valor negativo, el separador de decimales ''' y las teclas Intro, Delete, Back (borrar hacia atrás) ''' ''' Es raro, si teclasAceptadas es: ",-1234567890" también acepta el punto ''' </summary> Private Function AceptarTeclas(e As KeyPressEventArgs, teclasAceptadas As String) As Char Dim c = e.KeyChar If c = Convert.ToChar(Keys.Return) Then ' con esto hacemos que se ignore la pulsación e.Handled = True ' se manda al siguiente control SendKeys.Send("{TAB}") ElseIf c = Convert.ToChar(NoSeparadorDecimal) Then e.KeyChar = Convert.ToChar(SeparadorDecimal) ElseIf teclasAceptadas.Contains(c) Then ' no hacer nada, se aceptan ElseIf c = Convert.ToChar(Keys.Delete) OrElse c = Convert.ToChar(Keys.Back) Then ' no hacer nada, se aceptan Else e.Handled = True End If Return c End Function '-------------------------------------------------------------------------- ' Los métodos de evento del formulario '-------------------------------------------------------------------------- Private Sub btnCerrar_Click(sender As Object, e As EventArgs) Handles btnCerrar.Click Me.Close() End Sub Private Sub btnAsignarTabla1_Click(sender As Object, e As EventArgs) Handles btnAsignarTabla1.Click Dim d = 0@ Decimal.TryParse(txtTabla1_campo1.Text, d) Dim ret = AñadirMiTabla1(d) txtMensaje1.Text = "" If ret.hayError Then txtMensaje1.Text = "ERROR" & vbCrLf End If txtMensaje1.Text &= ret.msg End Sub Private Sub btnAsignarTabla2_Click(sender As Object, e As EventArgs) Handles btnAsignarTabla2.Click Dim valores(1) As Decimal Dim d = 0@ Decimal.TryParse(txtTabla2_campo1.Text, d) valores(0) = d d = 0@ Decimal.TryParse(txtTabla2_campo2.Text, d) valores(1) = d Dim ret = AñadirMiTabla2(valores) txtMensaje2.Text = "" If ret.hayError Then txtMensaje2.Text = "ERROR" & vbCrLf End If txtMensaje2.Text &= ret.msg End Sub Private Sub txt_KeyPress(sender As Object, e As KeyPressEventArgs) Handles _ txtTabla2_campo1.KeyPress, txtTabla1_campo1.KeyPress,
txtTabla2_campo2.KeyPress AceptarTeclas(e, SeparadorDecimal & "-1234567890") End Sub Private Sub btnMostrar1_Click(sender As Object, e As EventArgs) Handles btnMostrar1.Click ' mostrar los datos de MiTabla1 txtMensaje1.Text = leerMiTabla("MiTabla1") End Sub Private Sub btnMostrar2_Click(sender As Object, e As EventArgs) Handles btnMostrar2.Click ' mostrar los datos de MiTabla2 txtMensaje2.Text = leerMiTabla("MiTabla2") End Sub Private Sub Form1_KeyDown(sender As Object, e As KeyEventArgs) Handles MyBase.KeyDown ' detecta la pulsación de las teclas en el formulario ' antes de mandarla a los controles ' En el diseñador de formularios tienes que ' asignar un valor True a la propiedad KeyPreview If e.Modifiers = Keys.Control Then If e.KeyCode = Keys.C Then ' copiar el texto If TypeOf ActiveControl Is TextBox Then 'Dim texto = ActiveControl.Text 'Clipboard.SetText(texto) Dim txt = TryCast(ActiveControl, TextBox) If txt Is Nothing Then Return txt.Copy() e.Handled = True End If ElseIf e.KeyCode = Keys.V Then ' pegar el texto If TypeOf ActiveControl Is TextBox Then Dim txt = TryCast(ActiveControl, TextBox) If txt Is Nothing Then Return txt.Paste() e.Handled = True End If ElseIf e.KeyCode = Keys.X Then ' cortar el texto If TypeOf ActiveControl Is TextBox Then Dim txt = TryCast(ActiveControl, TextBox) If txt Is Nothing Then Return txt.Cut() e.Handled = True End If ElseIf e.KeyCode = Keys.Z Then 'deshacer If TypeOf ActiveControl Is TextBox Then Dim txt = TryCast(ActiveControl, TextBox) If txt Is Nothing Then Return If txt.CanUndo Then txt.Undo() End If e.Handled = True End If End If End If End Sub End Class
Espero que te sea de utilidad.
Nos vemos
Guillermo