UserForm "Modifier une ligne" qui rapatrie des nombres en texte, au lieu de nombres

Webperegrino

XLDnaute Impliqué
Supporter XLD
Bonjour Le Forum,

Question :
Connaissez-vous le moyen pour qu’un rapatriement de valeurs de ma base de données soient reconnues en tant que nombres et non en caractères texte ?
Vous trouverez ci-dessous le Code de mon UserForm.
Désolé la formule <[highlight]... [/code]> ne fonctionne pas plus bas dans le message

Détail de ma requête :
Un UserForm me pose des soucis car certains ComboBox devraient me rapatrier de la feuille « BaseDonnées » des nombres et non du texte comme actuellement.

Le contenu d’une cellule étant vide ou égale à 0 est indiqué dans le ComboBox de l’UserForm par ,00 et non 0,00.
Si une cellule ma base contient la valeur 1560 dans ma base, l’userform la rapatrie en texte !
Si je ne replace pas cette valeur (par-dessus) dans ce Combobox il repartira non plus en nombre mais en texte !
Ce qu’il ne faut surtout pas car j’ai des totaux et sous-totaux à effectuer dans la colonne de réception pour cette correction.

La seule parade que j’ai trouvée c’est de reprendre mes nombres dans les ComboBox à soucis avant de valider.
Alors et seulement cela ne perturbe pas les sous-totaux dans la base filtrée ou mes totaux de colonnes.

Si vous avez une solution à me proposez je suis vraiment preneur car mon UserForm m’oblige à pas mal de saisies en nombre sur ces « faux nombres en texte ».
Merci
Webperegrino

Posent souci :
TextBEspeces
TextBCheq
TexBCult
TexBVac
TextB

Code:
[highlight]
Option Explicit
Dim PlageBase As Range, ColTb As Collection
Dim IndexBase&, SurAjout As Boolean

Private Sub UserForm_Initialize()
Dim Bcle&, cel As Range, ArrTb
  Set ColTb = New Collection
  ArrTb = Array(TextBLign, TextBDate, TextBOrigine, TextBEspeces, TextBChq, TextBVac, TextBCult, TextBSTotal, TextBCB, TextBox20, TextBox21, TextBox22, TextBox23, TextBop)
  For Bcle = 0 To UBound(ArrTb)
  ColTb.Add ArrTb(Bcle), ArrTb(Bcle).Name
  Next Bcle
  With Feuil3
    Set PlageBase = .Range("A12", .Range("A12").End(xlDown))
  End With
  With SpinBBase
    .Min = 1
    .Max = PlageBase.Rows.Count
    .Value = 1
  End With
    TextBop.Value = Sheets("FORMULAIRES de Saisies").[$H$6].Text
End Sub
Private Sub AlimenteTb()
Application.ScreenUpdating = False
Dim Lgn As Range, Bcle&
  Set Lgn = PlageBase(IndexBase, 1)
  ColTb(1).Text = Lgn(1, 1).Value
  ColTb(2).Text = Lgn(1, 2).Value
  ColTb(2).Text = Format(CDate(ColTb(2).Text), "dd/mm/yy") '.Value ou .Text
  ColTb(3).Text = Lgn(1, 3).Value
  For Bcle = 4 To ColTb.Count
  ColTb(Bcle).Text = Lgn(1, Bcle).Value
  Select Case Bcle
    Case Else
    ColTb(Bcle).Value = Lgn(1, Bcle).Value
    End Select
    Next Bcle
  ColTb(4).Text = Format(CDbl(Lgn(1, 4).Value), "### ### ### ###,##.00") '"### ### ### ##0.00")
  ColTb(5).Text = Format(CDbl(Lgn(1, 5).Value), "### ### ### ###,##.00")
  ColTb(6).Text = Format(CDbl(Lgn(1, 6).Value), "### ### ### ###,##.00")
  ColTb(7).Text = Format(CDbl(Lgn(1, 7).Value), "### ### ### ###,##.00")
  ColTb(8).Text = Format(CDbl(Lgn(1, 8).Value), "### ### ### ###,##.00")
  ColTb(10).Text = Format(CDbl(Lgn(1, 10).Value), "### ### ### ###,##.00")
  ColTb(11).Text = Format(CDbl(Lgn(1, 11).Value), "### ### ### ###,##.00")
  LabIndex = "Fiche " & IndexBase & " sur " & PlageBase.Rows.Count
  Rows(IndexBase + 11).Select
  Application.ScreenUpdating = True
End Sub

Private Sub AjoutDansBase()
Application.ScreenUpdating = False
Dim Lgn As Range, Bcle&
  IndexBase = PlageBase.Rows.Count + 1
  Set PlageBase = PlageBase.Resize(IndexBase)
  Set Lgn = PlageBase(IndexBase, 1)
  Lgn(1, 1).Value = ColTb(1).Text
  Lgn(1, 2).Value = ColTb(2).Text
  Lgn(1, 2).Value = Format(CDate(Lgn(1, 2).Value), "dd/mm/yy")
  Lgn(1, 3).Value = ColTb(3).Text
  For Bcle = 4 To ColTb.Count
  Lgn(1, Bcle).Value = ColTb(Bcle).Text
   Next Bcle
Lgn(1, 8).Value = Lgn(1, 4).Value + Lgn(1, 5).Value + Lgn(1, 6).Value + Lgn(1, 7).Value 'S/Total
' Lgn(1, 8).Value = Val(Format(Replace(Lgn(1, 8).Value, ".", ","), "# ### ### ###.00"))
Lgn(1, 8).Value = Format(CDbl(Replace(Lgn(1, 8).Value, ".", ",")), "### ### ### ###,##.00")
'ligne 11 Total
Lgn(1, 11).Value = Lgn(1, 4).Value + Lgn(1, 5).Value + Lgn(1, 6).Value + Lgn(1, 7).Value + Lgn(1, 10).Value 'S/Total
Lgn(1, 11).Value = Format(CDbl(Replace(Lgn(1, 11).Value, ".", ",")), "### ### ### ###,##.00")
  AlimenteTb
  Application.ScreenUpdating = True
End Sub

Private Sub ModifieBase()
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect ("tikyt")
Dim Lgn As Range, Bcle&
  Set Lgn = PlageBase(IndexBase, 1)
  Lgn(1, 1).Value = ColTb(1).Text
  Lgn(1, 2).Value = ColTb(2).Text
  Lgn(1, 2).Value = Format(CDate(Lgn(1, 2).Value), "dd/mm/yy")
  Lgn(1, 3).Value = ColTb(3).Text
    For Bcle = 4 To ColTb.Count
      Lgn(1, Bcle).Value = ColTb(Bcle).Text
    Next Bcle
  Lgn(1, 8).Value = Lgn(1, 4).Value + Lgn(1, 5).Value + Lgn(1, 6).Value + Lgn(1, 7).Value 'S/Total
  Lgn(1, 11).Value = Lgn(1, 4).Value + Lgn(1, 5).Value + Lgn(1, 6).Value + Lgn(1, 7).Value + Lgn(1, 10).Value 'S/Total
  ActiveSheet.Protect ("tikyt")
  Application.ScreenUpdating = True
  Application.EnableEvents = True
End Sub

Private Sub BoutAjout_Click() 'Bouton pour modification
    Application.EnableEvents = False
  If TextBLign.Text = "" Then Beep: Exit Sub
  If SurAjout Then
    SurAjout = False
    BoutAjout.Caption = "Modifier"
    AjoutDansBase
  Else
    If IndexBase = 0 Then Beep Else ModifieBase
  End If
With Sheets("BALANCE_DÉTAILLÉE") '**Placement en BALANCE DETAILLEE
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    IntervS 'Intervention
    Sheets("BALANCE_DÉTAILLÉE").Unprotect ("tikyt")
    ActiveWindow.Zoom = 113
    Dim lig%
    lig% = TextBCB.Value
    .Range("A" & lig%).Value = Me.TextBDate.Value 'DATE
    .Range("A" & lig%).Value = Format(CDate(Me.TextBDate.Value), "mm/dd/yy")
    .Range("B" & lig%).Value = Me.TextBOrigine.Text
    .Range("J" & lig%).Value = Val(Me.TextBEspeces.Value)
    .Range("K" & lig%).Value = Val(Me.TextBChq.Value)
    .Range("L" & lig%).Value = Val(Me.TextBCult.Value)
    .Range("M" & lig%).Value = Val(Me.TextBVac.Value)
    .Range("N" & lig%).Value = Val(Me.TextBox20.Value) 'CartB
    .Range("O" & lig%).Value = .Range("J" & lig%).Value + .Range("K" & lig%).Value + .Range("L" & lig%).Value + .Range("M" & lig%).Value + .Range("N" & lig%).Value
    .Range("Q" & lig%).Value = .Range("J" & lig%).Value + .Range("K" & lig%).Value + .Range("L" & lig%).Value + .Range("M" & lig%).Value + .Range("N" & lig%).Value
    .Range("R" & lig%).Value = .Range("P" & lig%).Value - .Range("Q" & lig%).Value
    .Range("C" & lig%).Value = Me.TextBox23.Text 'SOrigine
    .Range("V" & lig%).Value = Me.TextBop.Value 'Detail bordereau
    Sheets("BALANCE_DÉTAILLÉE").Protect ("tikyt")
    Beep
    MsgBox "Modifié en ligne " & TextBLign & " dans la feuille ENTRÉES." & vbLf & vbLf & vbLf & "Modifié en ligne " & TextBCB & " dans la feuille BALANCE Détaillée."
    TextBLign = "" '** libère textBox EffaceChamps
    TextBDate = "" '**
    TextBOrigine = "" '**
    TextBEspeces = "" '**
    TextBChq = "" '**
    TextBCult = "" '**
    TextBVac = "" '**
    TextBSTotal = "" '**
    TextBox20 = "" '**
    TextBox21 = "" '**
    TextBox23 = "" '**
    TextBCB = "" '**
    Unload Me
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End With
'Sheets("Référentiel des Saisies ENTRÉES").Select
'Range("A1:M1").Select '*
'ActiveWindow.Zoom = True '113
'ActiveSheet.Protect ("tikyt")
Sheets("Référentiel des Saisies Entrées").Protect ("tikyt")
Sheets("FORMULAIRES de Saisies").Select
Range("A1").Select
ActiveSheet.Protect ("tikyt")

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub BoutLast_Click()
  SpinBBase.Value = PlageBase.Rows.Count
End Sub
Private Sub BoutPrem_Click()
  SpinBBase.Value = 1
End Sub
Private Sub BAnnule_Click() 'Sortir
  Unload Me
  Sheets("FORMULAIRES de Saisies").Select
End Sub
Private Sub CommandButton3_Click() 'Calculatrice
OuJeVeux
End Sub
Private Sub SpinBBase_Change()
  IndexBase = SpinBBase.Value
  AlimenteTb
End Sub
Private Sub TextBEspeces_Change() '**ESPECES
Calcul
End Sub
Private Sub TextBChq_Change() '**CHEQUES
Calcul
End Sub
Private Sub TextBCult_Change() '**CULTURE
Calcul
End Sub
Private Sub TextBVac_Change() '**VACANCE
Calcul
End Sub
Private Sub TextBox20_Change() '**CARTE BANCAIRE
Calcul
End Sub
Private Sub BoutInit_Click() 'Efface les champs
EffaceChamps
LabIndex = "Fiche..."
IndexBase = 0
End Sub
Private Sub Calcul()
Dim v1, v2, v3, v4, v5
v1 = Val(Replace(TextBEspeces, ",", "."))
v2 = Val(Replace(TextBChq, ",", "."))
v3 = Val(Replace(TextBCult, ",", "."))
v4 = Val(Replace(TextBVac, ",", "."))
v5 = Val(Replace(TextBox20, ",", "."))
TextBSTotal = Format(v1 + v2 + v3 + v4, "#,##0.00")
TextBox21 = Format(v1 + v2 + v3 + v4 + v5, "#,##0.00")
End Sub
Private Sub EffaceChamps() '*** libère textBox
Application.EnableEvents = False
Application.ScreenUpdating = False
TextBLign = ""
TextBDate = ""
TextBOrigine = ""
TextBEspeces = "0,00"
TextBChq = "0,00"
TextBCult = "0,00"
TextBVac = "0,00"
TextBSTotal = "" '0,00
TextBox20 = "0,00"
TextBox21 = ""
TextBox23 = ""
TextBCB = ""
'TextBop = ""
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Private Sub InscrireBase()
Application.EnableEvents = False
Application.ScreenUpdating = False
  Dim Lgn As Range, Bcle&
  Set Lgn = PlageBase(IndexBase, 1)
  Lgn(1, 1).Value = ColTb(1).Text
  Lgn(1, 2).Value = Format(ColTb(2).Text, "dd/mm/yy")
  Lgn(1, 3).Value = ColTb(3).Text
  For Bcle = 4 To ColTb.Count
    Lgn(1, Bcle).Value = ColTb(Bcle).Text
  Next Bcle
  Application.ScreenUpdating = True
  Application.EnableEvents = False
End Sub
Sub IntervS() ' 11/07/2008 Henri
Application.ScreenUpdating = False
Call AfficherBarres
ActiveSheet.Unprotect ("tikyt")

'Sheets("Référentiel des Saisies SORTIES").Select
'Range("B1").Select
'ActiveSheet.Unprotect ("tikyt")

'ActiveSheet.Unprotect ("tikyt")
'Sheets("Référentiel des Saisies ENTRÉES").Select
'Range("B2").Select

'Sheets("Tri").Select
'Range("D3").Select
'ActiveSheet.Unprotect ("tikyt")

'Sheets("ENTRÉES_SORTIES").Select
'Range("A1").Select
'ActiveSheet.Unprotect ("tikyt")

Sheets("BALANCE_DÉTAILLÉE").Select
Range("A7").Select
ActiveSheet.Unprotect ("tikyt")
Application.ScreenUpdating = True

'ActiveSheet.Unprotect ("tikyt")
'Sheets("Référentiel des Saisies ENTRÉES").Select
'Range("B2").Select
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  If CloseMode = 0 Then Cancel = True
End Sub
[/Code]
 
Dernière édition:

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi