Pb d'adaptation au format

oasis_1 · 25 Octobre 2008

Bonjour le Forum,

j'utilise une userform pour modifier si il y a besoin un tableau.

le tableau étant trop lourd ci joint les formules vba

Private Sub TextBox4_Change()
TextBox4 = Format(TextBox4.Value, " 0 000.00 " & " €")
End Sub

Private Sub TextBox5_Change()
TextBox5 = Format(TextBox5.Value, " 0 000.00 " & " €")
End Sub

Private Sub TextBox6_Change()
TextBox6 = Format(TextBox6.Value, " 000.00 " & " €")
End Sub

pour que les textbox affiche en €

puis la validation pour enregistrer :

Private Sub Enregistré_Click() 'Bibliothèque
Dim Nb As Integer, Dnb As Integer, i As Integer, Y As String
Dim Element_Select As String
Dnb = Sheets("Semaine").Range("w2").Value
Nb = UserForm18.ListBox1.ListCount
Element_Select = False
Sheets("Semaine").Activate

' TextBox = Format(TextBox.Value, " 0.00 €")
Y = 4 'Sur Feuil2 ligne de départ de la bibli ----> "A3"

'----------- MODIFICATION DES DONNEES EN BIBLI ----------
For i = 0 To Nb - 1
If UserForm18.ListBox1.Selected(i) = True Then
Element_Select = True
Range("b" & i + Y).Value = TextBox2
Range("c" & i + Y).Value = TextBox3
Range("d" & i + Y).Value = TextBox4
Range("e" & i + Y).Value = TextBox5
Range("f" & i + Y).Value = TextBox6
With Range("f" & i + Y)
.HorizontalAlignment = xlHAlignRight
.VerticalAlignment = xlVAlignCenter
With .Font
' .Size = 10
' .Italic = False
'.Bold = False
' .Name = "Arial"
End With
End With
End If
Next
If Element_Select = True Then
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = False

TextBox2 = Clear
TextBox3 = Clear
TextBox4 = Clear
TextBox5 = Clear
TextBox6 = Clear
Next i
End If

'------------- AJOUT DE DONNEES EN BIBLI ----------------
If Element_Select = False Then

Range("b" & Dnb + Y).Value = TextBox2
Range("c" & Dnb + Y).Value = TextBox3
Range("d" & Dnb + Y).Value = TextBox4
Range("e" & Dnb + Y).Value = TextBox5
Range("f" & Dnb + Y).Value = TextBox6
With Range("f" & i + Y)
.HorizontalAlignment = xlHAlignRight
.VerticalAlignment = xlVAlignCenter
End With
Dnb = Dnb + 2
ElseIf TextBox2 = "" Then
Dnb = Dnb - 1
For J = 0 To Nb + 4
If "" = Range("b" & J + Y).Value Then 'supprime ligne vide
Range("b" & J + Y).Select
For X = -1 To 2
Range("b" & J + Y).Offset(0, X) = Range("b" & J + Y).Offset(1, X).Value
Range("b" & J + Y).Offset(1, X).Value = Clear
Next
End If
Next
Else
End If

TextBox2 = Clear
TextBox3 = Clear
TextBox4 = Clear
TextBox5 = Clear
TextBox6 = Clear
Call box1
Dnb = Sheets("Semaine").Range("w2").Value
' UserForm1.Label7.Caption = "Quantité Données Bibliothèque : " & dnb
ActiveWorkbook.Save
Sheets("Semaine").Protect
End Sub

Seulement pas tres pratique et je souhaiterai pouvoir intégrer directement dans Private Sub Enregistré .

pour qu'au final en validant les textbox 4,5 et 6 s'affiche sur ma feuille au bon format

merci par avance

oasis_1 · 26 Octobre 2008

Re : Pb d'adaptation au format

Re,

En effet Msgbox "je suis dans boucle 1" fonctionne bien

et enremettant les formules comme à l'initiale je n'est pas la deuxième boite de dialogue mais le chiffre s'impacte par contre le calcul ne se fait pas

comment t'envoyer mon fichier s'achant qu'il dépasse largement les 48 k

Roland_M · 26 Octobre 2008

Re : Pb d'adaptation au format

re:

plus de 48 même zippé !?

oasis_1 · 26 Octobre 2008

Re : Pb d'adaptation au format

Re,

Ci-joint le fichier épuré l'userform qui s'affiche en vide sauf la touche "Correction" là nous arrivons sur l'userform qui pose problème

Pour résumer l'1er user sert à remplir le tableau mais si il y a correction le 2ème sert donc à pouvoir modifier, le seul PB est que si je veux en mode correction avoir une valeur en D5 tout en gardant la valeur de E5 le calcul ne se fait pas

Roland_M · 26 Octobre 2008

Re : Pb d'adaptation au format

re

j'y regarde mais ce n'est pas évident ! et je dois partir bientôt (on m'invite pour l'apéro)

par contre j'ai déjà vu pourquoi le calcul ne fait pas !
il s'agit bien de format envoyé avec (,) depuis Vb
pour preuve tu clic sur le cellule E5(sans l'ouvrir) et tu verras le signe [!] d'excel
qui te dis(si tu laisse le pointeur souris dessus) que le nombre est au format texte !!!!!

Roland_M · 26 Octobre 2008

Re : Pb d'adaptation au format

re:

il semblerait que le fait d'avoir mis déjà des formats dans les TextBox
le collage par TextBox?.Value suffise !
sinon il y a double emploie et très certainement perturbation !

j'ai juste fait des essais ainsi et ça marche !
à toi de revoir et vérifier ton code mais j'ai juste remis .Value

oasis_1 · 26 Octobre 2008

Re : Pb d'adaptation au format

Re,

En espérant que l'apéro était bon mais court

En effet ça marche et meme tres bien merci pour ton aide à force de compliquer!!!!

oasis_1 · 28 Octobre 2008

Re : Pb d'adaptation au format

Bonjour le Forum,

Je reviens vers vous le fichier ci-joint fonctionne mais ne m'impacte que la feuille semaine mais le but en que lorsque je fais une correction cette correction s'applique à toutes les feuilles ( semaine, mois, année )

en espérent avoir été claire

oasis_1 · 28 Octobre 2008

Re : Pb d'adaptation au format

Re le forum,

Peu etre mal expliqué,

Mon 1er Userform"2"me permet d'impacter ma semaine ainsi que le Mois et l'année.

Le 2ème Userform"1" me permet de corriger si j'ai fais une erreur

Le problème est qu'il corrige uniquement la feuille semaine et qu'il ne s'impacte pas sur le "Mois" et sur L'"Année".

Donc ma question car je bloque dur : est il possible en corrigent via userform1 d'impacter les 3 feuilles

En espérent avoir été plus claire cette fois ci.

Roland_M · 28 Octobre 2008

Re : Pb d'adaptation au format

bonsoir

comme ça à vue d'oeil je crois que tu vas devoir rajouter tous les noms de feuille
à chaque svg de Range partout ! exemple :

'----------- MODIFICATION DES DONNEES EN BIBLI ----------
For i = 0 To Nb - 1
If UserForm1.ListBox1.Selected(i) = True Then
Element_Select = True
Sheets("Semaine").Range("b" & i + Y).Value = TextBox2.Value '<<<<<<<<<<<
Sheets("Mois").Range("b" & i + Y).Value = TextBox2.Value '<<<<<<<<<<<
Sheets("Année").Range("b" & i + Y).Value = TextBox2.Value '<<<<<<<<<<<

Sheets("Semaine").Range("c" & i + Y).Value = TextBox3.Value '<<<<<<<<<<<
Sheets("Mois").Range("c" & i + Y).Value = TextBox3.Value '<<<<<<<<<<<
Sheets("Année").Range("c" & i + Y).Value = TextBox3.Value '<<<<<<<<<<<

Roland_M · 28 Octobre 2008

Re : Pb d'adaptation au format

re:

pour raccourcir le code tu crées un tableau des trois feuilles
et tu boucles comme ci-dessous. (à bien vérifier j'ai pas testé, j'ai fais vite !)

je l'ai fais dans ton classeur mais maintenant même zippé il dépasse 50Ko

Code:

Private Sub Enregistré_Click() 'Bibliothèque
    Dim Nb As Integer, Dnb As Integer, i As Integer, Y As String
    Dim Element_Select As String
    Dnb = Sheets("Semaine").Range("w2").Value
    Nb = UserForm1.ListBox1.ListCount
    Element_Select = False
    Sheets("Semaine").Activate
    Y = 4 'Sur Feuil2 ligne de départ de la bibli ----> "A3"
    
'----------- MODIFICATION DES DONNEES EN BIBLI ----------
ReDim FeuilTEMP$(1 To 3)
FeuilTEMP$(1) = "Semaine": FeuilTEMP$(2) = "Mois": FeuilTEMP$(3) = "Année"
For i = 0 To Nb - 1
 If UserForm1.ListBox1.Selected(i) = True Then
        Element_Select = True
    For Feuil = 1 To 3: F$ = FeuilTEMP$(Feuil)
        Sheets(F$).Range("b" & i + Y).Value = TextBox2.Value
        Sheets(F$).Range("c" & i + Y).Value = TextBox3.Value
        If IsNumeric(TextBox4.Value) Then   ' on vérifie si la valeur est numérique
         Sheets(F$).Range("d" & i + Y).Value = TextBox4.Value
        End If
        If IsNumeric(TextBox5.Value) Then   ' on vérifie si la valeur est numérique
          Sheets(F$).Range("e" & i + Y).Value = TextBox5.Value
        End If
       If IsNumeric(TextBox6.Value) Then   ' on vérifie si la valeur est numérique
          Sheets(F$).Range("f" & i + Y).Value = TextBox6.Value
        End If
        With Sheets(F$).Range("f" & i + Y)
            .HorizontalAlignment = xlHAlignRight
            .VerticalAlignment = xlVAlignCenter
                With .Font
                  '  .Size = 10
                  '  .Italic = False
                    '.Bold = False
                   ' .Name = "Arial"
                End With
        End With
    Next Feuil
 End If
Next
If Element_Select = True Then
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = False
        TextBox2 = Clear
        TextBox3 = Clear
        TextBox4 = Clear
        TextBox5 = Clear
        TextBox6 = Clear
    Next i
End If
    
'------------- AJOUT DE DONNEES EN BIBLI ----------------
If Element_Select = False Then
   For Feuil = 1 To 3: F$ = FeuilTEMP$(Feuil)
     Sheets(F$).Range("b" & Dnb + Y).Value = TextBox2.Value
     Sheets(F$).Range("c" & Dnb + Y).Value = TextBox3.Value
     Sheets(F$).Range("d" & Dnb + Y).Value = TextBox4.Value
     Sheets(F$).Range("e" & Dnb + Y).Value = TextBox5.Value
     Sheets(F$).Range("f" & Dnb + Y).Value = TextBox6.Value
     With Sheets(F$).Range("f" & i + Y)
        .HorizontalAlignment = xlHAlignRight
        .VerticalAlignment = xlVAlignCenter
     End With
    Dnb = Dnb + 2
   Next Feuil
   ElseIf TextBox2 = "" Then
        Dnb = Dnb - 1
        For Feuil = 1 To 3: F$ = FeuilTEMP$(Feuil)
        For J = 0 To Nb + 4
            If "" = Sheets(F$).Range("b" & J + Y).Value Then 'supprime ligne vide
                Sheets(F$).Range("b" & J + Y).Select
                For X = -1 To 2
                    Sheets(F$).Range("b" & J + Y).Offset(0, X) = Sheets(F$).Range("b" & J + Y).Offset(1, X).Value
                    Sheets(F$).Range("b" & J + Y).Offset(1, X).Value = Clear
                Next
            End If
        Next
       Next Feuil
End If
  Application.Calculate
    TextBox2 = Clear
    TextBox3 = Clear
    TextBox4 = Clear
    TextBox5 = Clear
    TextBox6 = Clear
    Call box1
  Dnb = Sheets("Semaine").Range("w2").Value
ActiveWorkbook.Save
End Sub

EDIT !!!! j'ai corrigé une erreur !!!

oasis_1 · 28 Octobre 2008

Re : Pb d'adaptation au format

Bonsoir Roland M,

Tout d'abord merci je pense que d'en 10 siècles j'y serai encore
Par contre il semble qu'il y a un problème avec les Else et If au niveaux AJOUT DE DONNEES marqué en bleu dans le code
J'ai bien essayé de rajouter End If un peu partout mais aucun résultat

Code:

Private Sub Enregistré_Click() 'Bibliothèque
    Dim Nb As Integer, Dnb As Integer, i As Integer, Y As String
    Dim Element_Select As String
    Dnb = Sheets("Semaine").Range("w2").Value
    Nb = UserForm1.ListBox1.ListCount
    Element_Select = False
    Sheets("Semaine").Activate
    Y = 4 'Sur Feuil2 ligne de départ de la bibli ----> "A3"
    
'----------- MODIFICATION DES DONNEES EN BIBLI ----------
ReDim FeuilTEMP$(1 To 3)
FeuilTEMP$(1) = "Semaine": FeuilTEMP$(2) = "Mois": FeuilTEMP$(3) = "Année"
For i = 0 To Nb - 1
 If UserForm1.ListBox1.Selected(i) = True Then
        Element_Select = True
    For Feuil = 1 To 3: F$ = FeuilTEMP$(Feuil)
        Sheets(F$).Range("b" & i + Y).Value = TextBox2.Value
        Sheets(F$).Range("c" & i + Y).Value = TextBox3.Value
        If IsNumeric(TextBox4.Value) Then   ' on vérifie si la valeur est numérique
         Sheets(F$).Range("d" & i + Y).Value = TextBox4.Value
        End If
        If IsNumeric(TextBox5.Value) Then   ' on vérifie si la valeur est numérique
          Sheets(F$).Range("e" & i + Y).Value = TextBox5.Value
        End If
       If IsNumeric(TextBox6.Value) Then   ' on vérifie si la valeur est numérique
          Sheets(F$).Range("f" & i + Y).Value = TextBox6.Value
        End If
        With Sheets(F$).Range("f" & i + Y)
            .HorizontalAlignment = xlHAlignRight
            .VerticalAlignment = xlVAlignCenter
                With .Font
                  '  .Size = 10
                  '  .Italic = False
                    '.Bold = False
                   ' .Name = "Arial"
                End With
        End With
    Next Feuil
 End If
Next
If Element_Select = True Then
    For i = 0 To ListBox1.ListCount - 1
        ListBox1.Selected(i) = False
        TextBox2 = Clear
        TextBox3 = Clear
        TextBox4 = Clear
        TextBox5 = Clear
        TextBox6 = Clear
    Next i
End If
    
'------------- AJOUT DE DONNEES EN BIBLI ----------------
If Element_Select = False Then
   For Feuil = 1 To 3: F$ = FeuilTEMP$(Feuil)
     Sheets(F$).Range("b" & Dnb + Y).Value = TextBox2.Value
     Sheets(F$).Range("c" & Dnb + Y).Value = TextBox3.Value
     Sheets(F$).Range("d" & Dnb + Y).Value = TextBox4.Value
     Sheets(F$).Range("e" & Dnb + Y).Value = TextBox5.Value
     Sheets(F$).Range("f" & Dnb + Y).Value = TextBox6.Value
     With Sheets(F$).Range("f" & i + Y)
        .HorizontalAlignment = xlHAlignRight
        .VerticalAlignment = xlVAlignCenter
     End With
    Dnb = Dnb + 2
   Next Feuil
   [COLOR="Blue"]ElseIf TextBox2 = "" Then[/COLOR]
        Dnb = Dnb - 1
        For Feuil = 1 To 3: F$ = FeuilTEMP$(Feuil)
        For J = 0 To Nb + 4
            If "" = Sheets(F$).Range("b" & J + Y).Value Then 'supprime ligne vide
                Sheets(F$).Range("b" & J + Y).Select
                For X = -1 To 2
                    Sheets(F$).Range("b" & J + Y).Offset(0, X) = Sheets(F$).Range("b" & J + Y).Offset(1, X).Value
                    Sheets(F$).Range("b" & J + Y).Offset(1, X).Value = Clear
                Next
            End If
        Next
       Next Feuil
End If
  Application.Calculate
    TextBox2 = Clear
    TextBox3 = Clear
    TextBox4 = Clear
    TextBox5 = Clear
    TextBox6 = Clear
    Call box1
  Dnb = Sheets("Semaine").Range("w2").Value
ActiveWorkbook.Save
End Sub

oasis_1 · 28 Octobre 2008

Re : Pb d'adaptation au format

Re,

j'avais oublier d'enlever Else.

Par contre la formule fonctionne mais j'ai une erreur 1004 qui m'indique "la méthode Select de la classe Range a échoué"

Sachant qu'en validant sa s'implique bien dans les 3 feuilles, malgré l'erreur ???

oasis_1 · 28 Octobre 2008

Re : Pb d'adaptation au format

Re,

Problème résolu il fallait enlever Sheets(F$). dans AJOUT DE DONNEES au niveaux :

For Feuil = 1 To 3: F$ = FeuilTEMP$(Feuil)
For J = 0 To Nb + 4
If "" = Sheets(F$).Range("b" & J + Y).Value Then 'supprime ligne vide
Sheets(F$).Range("b" & J + Y).Select
For X = -1 To 2
Sheets(F$).Range("b" & J + Y).Offset(0, X) = Sheets(F$).Range("b" & J + Y).Offset(1, X).Value
Sheets(F$).Range("b" & J + Y).Offset(1, X).Value = Clear
Next
End If
Next
Next Feuil
End If
Application.Calculate
TextBox2 = Clear
TextBox3 = Clear
TextBox4 = Clear
TextBox5 = Clear
TextBox6 = Clear
Call box1
Dnb = Sheets("Semaine").Range("w2").Value
ActiveWorkbook.Save
End Sub

Merci encore pour le coup de main et +

Roland_M · 29 Octobre 2008

Re : Pb d'adaptation au format

re:

c'est normal tu as une erreur de déclaration !!!!!!!!!
tu as mis ceci:
Dim Nb As Integer, Dnb As Integer, i As Integer, Y As String

tu dois rectifier par Y As Integer

alors que c'est une variable numérique !!!!!
elle est la cause de beaucoup de tes problèmes parcequ'ellle ne compte pas !
ici plus bas juste après *******************

Dim Element_Select As String
Dnb = Sheets("Semaine").Range("w2").Value
Nb = UserForm1.ListBox1.ListCount
Element_Select = False
Sheets("Semaine").Activate
Y = 4 'Sur Feuil2 li ' *******************

Roland_M · 29 Octobre 2008

Re : Pb d'adaptation au format

re:

surtout pas malheureux !

quand tu fais débogage tu passe la souris dessus le Y et tu verras qu'il t'indique "4"
donc une variable nom numérique !

laisse sheets(

Pb d'adaptation au format

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums