Enregistrement de données

Le 08/03/2013 à 00:37

bonsoir encore une incoérance !

j'ai le code suivant :

Sub enregistrer()
Dim xnumero As Integer
Fac_Dev = Cells(1, 9)
Fac_Num = Cells(1, 10)
Xonglet = Cells(1, 17)
chemin = Sheets("facture").Range("Q30")
If Cells(1, 10) = "" Then  'numero de doc
        MsgBox ("coisir un type de documment")
        Exit Sub
    End If
If Cells(41, 10) = "0" Then  'facture vide
        MsgBox ("votre facture est vide")
        Exit Sub
    End If

If Cells(45, 4) = "" Then  'reglement
       reponse = MsgBox("saisisé le mode de reglement", vbYesNo)
       If reponse = vbYes Then Exit Sub

End If
Application.ScreenUpdating = False 'enregistrement du document dans la base
reponse = MsgBox("Voulez-vous enregistrer :" & Fac_Dev & Fac_Num & " ?", vbYesNo)

            If reponse = vbNo Then Exit Sub

With Sheets(Xonglet) 'selection des données a enregistrer
    x = .Range("A65536").End(xlUp).Row
    xnumero = Right(.Cells(x, 1), 5)
End With
NFacture = Right(Cells(1, 10), 5) - 1

If NFacture = xnumero Then
    With Sheets(Xonglet)

        i = .Range("A65536").End(3)(2).Row
        .Cells(i, 1) = Sheets("recup").Range("J1") ' Numéro Devis ou Facture ou commande
        .Cells(i, 2) = Range("R_nom")
        .Cells(i, 3) = Range("R_prenom")
        .Cells(i, 4) = Range("R_adresse")
        .Cells(i, 5) = Range("R_code_postal")
        .Cells(i, 6) = Range("R_ville")
        .Cells(i, 7) = Range("R_date")
        .Cells(i, 8) = Range("R_num")
        .Cells(i, 9) = Range("B15")
        .Cells(i, 10) = Range("h15")
        .Cells(i, 11) = Range("I15")
        .Cells(i, 12) = Range("J15")
        .Cells(i, 13) = Range("B16")
        .Cells(i, 14) = Range("h16")
        .Cells(i, 15) = Range("I16")
        .Cells(i, 16) = Range("J16")
        .Cells(i, 17) = Range("B17")
        .Cells(i, 18) = Range("h17")
        .Cells(i, 19) = Range("I17")
        .Cells(i, 20) = Range("J17")
        .Cells(i, 21) = Range("B18")
        .Cells(i, 22) = Range("h18")
        .Cells(i, 23) = Range("I18")
        .Cells(i, 24) = Range("J18")
        .Cells(i, 25) = Range("B19")
        .Cells(i, 26) = Range("h19")
        .Cells(i, 27) = Range("I19")
        .Cells(i, 28) = Range("J19")
        .Cells(i, 29) = Range("B20")
        .Cells(i, 30) = Range("h20")
        .Cells(i, 31) = Range("I20")
        .Cells(i, 32) = Range("J20")
        .Cells(i, 33) = Range("B21")
        .Cells(i, 34) = Range("h21")
        .Cells(i, 35) = Range("I21")
        .Cells(i, 36) = Range("J21")
        .Cells(i, 37) = Range("B22")
        .Cells(i, 38) = Range("h22")
        .Cells(i, 39) = Range("I22")
        .Cells(i, 40) = Range("J22")
        .Cells(i, 41) = Range("B23")
        .Cells(i, 42) = Range("h23")
        .Cells(i, 43) = Range("I23")
        .Cells(i, 44) = Range("J23")
        .Cells(i, 45) = Range("B24")
        .Cells(i, 46) = Range("h24")
        .Cells(i, 47) = Range("I24")
        .Cells(i, 48) = Range("J24")
        .Cells(i, 49) = Range("B25")
        .Cells(i, 50) = Range("h25")
        .Cells(i, 51) = Range("I25")
        .Cells(i, 52) = Range("J25")
        .Cells(i, 53) = Range("B26")
        .Cells(i, 54) = Range("h26")
        .Cells(i, 55) = Range("I26")
        .Cells(i, 56) = Range("J26")
        .Cells(i, 57) = Range("B27")
        .Cells(i, 58) = Range("h27")
        .Cells(i, 59) = Range("I27")
        .Cells(i, 60) = Range("J27")
        .Cells(i, 61) = Range("B28")
        .Cells(i, 62) = Range("h28")
        .Cells(i, 63) = Range("I28")
        .Cells(i, 64) = Range("J28")
        .Cells(i, 65) = Range("B29")
        .Cells(i, 66) = Range("h29")
        .Cells(i, 67) = Range("I29")
        .Cells(i, 68) = Range("J29")
        .Cells(i, 69) = Range("B30")
        .Cells(i, 70) = Range("h30")
        .Cells(i, 71) = Range("I30")
        .Cells(i, 72) = Range("J30")
        .Cells(i, 73) = Range("B31")
        .Cells(i, 74) = Range("h31")
        .Cells(i, 75) = Range("I31")
        .Cells(i, 76) = Range("J31")
        .Cells(i, 77) = Range("B32")
        .Cells(i, 78) = Range("h32")
        .Cells(i, 79) = Range("I32")
        .Cells(i, 80) = Range("J32")
        .Cells(i, 81) = Range("B33")
        .Cells(i, 82) = Range("h33")
        .Cells(i, 83) = Range("I33")
        .Cells(i, 84) = Range("J33")
        .Cells(i, 85) = Range("B34")
        .Cells(i, 86) = Range("h34")
        .Cells(i, 87) = Range("I34")
        .Cells(i, 88) = Range("J34")
        .Cells(i, 89) = Range("B35")
        .Cells(i, 90) = Range("h35")
        .Cells(i, 91) = Range("I35")
        .Cells(i, 92) = Range("J35")
        .Cells(i, 93) = Range("B36")
        .Cells(i, 94) = Range("h36")
        .Cells(i, 95) = Range("I36")
        .Cells(i, 96) = Range("J36")
        .Cells(i, 97) = Range("B37")
        .Cells(i, 98) = Range("h37")
        .Cells(i, 99) = Range("I37")
        .Cells(i, 100) = Range("J37")
        .Cells(i, 101) = Range("B38")
        .Cells(i, 102) = Range("h38")
        .Cells(i, 103) = Range("I38")
        .Cells(i, 104) = Range("J38")
        .Cells(i, 105) = Range("B39")
        .Cells(i, 106) = Range("h39")
        .Cells(i, 107) = Range("I39")
        .Cells(i, 108) = Range("J39")
        .Cells(i, 109) = Range("B40")
        .Cells(i, 110) = Range("h40")
        .Cells(i, 111) = Range("I40")
        .Cells(i, 112) = Range("J40")
        .Cells(i, 113) = Range("R_total")
        .Cells(i, 114) = Range("R_acompte")
        .Cells(i, 115) = Range("R_net_a_payer")
        .Cells(i, 116) = Range("R_reglement")
        .Cells(i, 117) = Range("R_mail")
        .Cells(i, 118) = Range("G12")
        .Cells(i, 119) = Range("R_tiers1")

 End With 'document a imprimer
   reponse = MsgBox("Voulez-vous imprimer :" & Fac_Dev & Fac_Num & " ?", vbYesNo)
            If reponse = vbYes Then
            ActiveSheet.PageSetup.PrintArea = "$B$1:J53"
            ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
            If reponse = vbNo Then Exit Sub
            End If

 Dim Rep As Integer
    fact = Sheets("recup").Range("Q1")
    fact1 = Sheets("recup").Range("J1")
  Rep = MsgBox("Voulez-vous sauvegarder en pdf ?", vbYesNo)
    If Rep = vbYes Then

End If

    If fact = "base_devis" Then
        Sheets("recup").Range("B1:T53").Select
        ActiveSheet.PageSetup.PrintArea = "$B$1:$J$53"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 chemin & "\archive devis\devis" & fact1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False

End If
    If fact = "base_commande" Then
    Sheets("recup").Range("B1:T53").Select
        ActiveSheet.PageSetup.PrintArea = "$B$1:$J$53"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 chemin & "\archive commandes\commande" & fact1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    End If

    If fact = "base_facture" Then
    Sheets("recup").Range("B1:T53").Select
        ActiveSheet.PageSetup.PrintArea = "$B$1:$J$53"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 chemin & "\archive factures\facture" & fact1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False

        End If

 'effacemment du document
    Range("B15:I40").ClearContents
    Range("Q8").ClearContents
    Range("R8").ClearContents

    Range("D45").ClearContents
    Range("Q1").ClearContents
    Range("J1").ClearContents
    Range("acompte").ClearContents
    Range("tiers1").ClearContents
    End If
Application.ScreenUpdating = True  ' retour a ma facture

Sheets("recup").Range("A1").Select

End Sub

il fonctionne mais il est long donc j'ai voulu le racourcir et je l'ai remplacer par :

Sub enregistrer1()
Dim xnumero As Integer
Fac_Dev = Cells(1, 9)
Fac_Num = Cells(1, 10)
Xonglet = Cells(1, 17)
chemin = Sheets("facture").Range("Q30")
Dim Colonne As Integer

If Cells(45, 4) = "" Then  'reglement
       reponse = MsgBox("saisisé le mode de reglement", vbYesNo)
       If reponse = vbYes Then Exit Sub

End If
Application.ScreenUpdating = False 'enregistrement du document dans la base
reponse = MsgBox("Voulez-vous enregistrer :" & Fac_Dev & Fac_Num & " ?", vbYesNo)

            If reponse = vbNo Then Exit Sub

With Sheets(Xonglet) 'selection des données a enregistrer
    x = .Range("A65536").End(xlUp).Row
    xnumero = Right(.Cells(x, 1), 5)
End With
NFacture = Right(Cells(1, 10), 5) - 1

If NFacture = xnumero Then
    With Sheets(Xonglet)

        i = .Range("A65536").End(3)(2).Row
        .Cells(i, 1) = Sheets("recup").Range("J1") ' Numéro Devis ou Facture ou commande
        .Cells(i, 2) = Range("R_nom")
        .Cells(i, 3) = Range("R_prenom")
        .Cells(i, 4) = Range("R_adresse")
        .Cells(i, 5) = Range("R_code_postal")
        .Cells(i, 6) = Range("R_ville")
        .Cells(i, 7) = Range("R_date")
        .Cells(i, 8) = Range("R_num")
        .Cells(i, 113) = Range("R_total")
        .Cells(i, 114) = Range("R_acompte")
        .Cells(i, 115) = Range("R_net_a_payer")
        .Cells(i, 116) = Range("R_reglement")
        .Cells(i, 117) = Range("R_mail")
        .Cells(i, 118) = Range("G12")
        .Cells(i, 119) = Range("R_tiers1")
        For i = 1 To 104
            .Cells(i, 9) = Range("B15")
            .Cells(i, 10) = Range("H15")
            .Cells(i, 11) = Range("I15")
            .Cells(i, 12) = Range("J15")

        Next i

 End With 'document a imprimer
   reponse = MsgBox("Voulez-vous imprimer :" & Fac_Dev & Fac_Num & " ?", vbYesNo)
            If reponse = vbYes Then
            ActiveSheet.PageSetup.PrintArea = "$B$1:J53"
            ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
            If reponse = vbNo Then Exit Sub
            End If

 Dim Rep As Integer
    fact = Sheets("recup").Range("Q1")
    fact1 = Sheets("recup").Range("J1")
  Rep = MsgBox("Voulez-vous sauvegarder en pdf ?", vbYesNo)
    If Rep = vbYes Then

End If

    If fact = "base_devis" Then
        Sheets("recup").Range("B1:T53").Select
        ActiveSheet.PageSetup.PrintArea = "$B$1:$J$53"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 chemin & "\archive devis\devis" & fact1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False

End If
    If fact = "base_commande" Then
    Sheets("recup").Range("B1:T53").Select
        ActiveSheet.PageSetup.PrintArea = "$B$1:$J$53"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 chemin & "\archive commandes\commande" & fact1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False
    End If

    If fact = "base_facture" Then
    Sheets("recup").Range("B1:T53").Select
        ActiveSheet.PageSetup.PrintArea = "$B$1:$J$53"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 chemin & "\archive factures\facture" & fact1 & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    From:=1, To:=1, OpenAfterPublish:=False

        End If

Application.ScreenUpdating = True  ' retour a ma facture
End If

Sheets("recup").Range("A1").Select

End Sub

et maintenant le bug est le suivant l'ors de l'enregistrement dans ma base il enregistre les donnée de ma boucle

 For i = 1 To 104
            .Cells(i, 9) = Range("B15")
            .Cells(i, 10) = Range("H15")
            .Cells(i, 11) = Range("I15")
            .Cells(i, 12) = Range("J15")

        Next i

dans la totalité des colonnes concerné au lieu de le faire sur une ligne seulement

si en B15 il y a un 3 il enregistre 3 dans toutes les case de la celule de la colonne 9 de ma base au lieu de le faire que dans une case de la colonne 9 alors que les autre données comme le nom par exemple (.Cells(i, 2) = Range("R_nom")) n'est enregistrer que dans une case

ou est le problème

merci

Le 08/03/2013 à 16:12

Bonjour,

Tu dis :

et maintenant le bug est le suivant l'hors de l'enregistrement dans ma base il enregistre les données de ma boucle dans la totalité des colonnes concernées au lieu de le faire sur une ligne seulement

si en B15 il y a un 3 il enregistre 3 dans toutes les case de la cellule de la colonne 9 de ma base au lieu de le faire que dans une case de la colonne 9 alors que les autre données comme le nom par exemple (.Cells(i, 2) = Range("R_nom")) n'est enregistrer que dans une case

C'est tout à fais normal, pour ".Cells(i, 2) = Range("R_nom")" entre autres, i a pour valeur le numéro de la ligne vide sous la dernière cellule utilisée de la colonne A (i = .Range("A65536").End(3)(2).Row), sa valeur n'est pas incrémentée dans une boucle !!!

Pour :

 For i = 1 To 104
            .Cells(i, 9) = Range("B15")
            .Cells(i, 10) = Range("H15")
            .Cells(i, 11) = Range("I15")
            .Cells(i, 12) = Range("J15")

        Next i

Les valeurs de B15, H15, I15 et J15 sont inscrite de la ligne 1 à la ligne 104 dans les colonnes I à L puisque tu boucle de 1 à 104 !!!

Il te faut faire une boucle en incrémentant les colonnes et pas les lignes (la valeur de i ne doit pas changer) mais tu dois aussi incrémenter les lignes pour la récup des données à partir de B15, H15, etc..., enfin si j'ai bien compris ton code. Remplace ta boucle ci-dessous par celle-ci et dis moi si c'est ce que tu cherche :

For j = 9 To 112 Step 4

    Cells(i, j) = Range("B" & 15 + k)
    Cells(i, j + 1) = Range("H" & 15 + k)
    Cells(i, j + 2) = Range("I" & 15 + k)
    Cells(i, j + 3) = Range("J" & 15 + k)
    k = k + 1

Next j

Hervé.

Le 08/03/2013 à 16:57

bonjours hervé je vient de tester la boucle effectivement cela copie mais de la facon suivante:

la premiere partie est bien copier dans la bonne base mais la partie correspondant a la boucle est enregistrer dans ma feuille recup au lieu d'etre enregistrer dans la base choisi par xonglet (soit base_facture, soit base_devis, soit base _commande) en fonction du type de document.

au commencement il ma mis variable inconnu pour J donc je l'est déclarer comme pour i

Dim J As Long

puis il la boucle a tourné mais cette partie la :

i = .Range("A65536").End(3)(2).Row
        .Cells(i, 1) = Sheets("recup").Range("J1") ' Numéro Devis ou Facture ou commande
        .Cells(i, 2) = Range("R_nom")
        .Cells(i, 3) = Range("R_prenom")
        .Cells(i, 4) = Range("R_adresse")
        .Cells(i, 5) = Range("R_code_postal")
        .Cells(i, 6) = Range("R_ville")
        .Cells(i, 7) = Range("R_date")
        .Cells(i, 8) = Range("R_num")
        .Cells(i, 113) = Range("R_total")
        .Cells(i, 114) = Range("R_acompte")
        .Cells(i, 115) = Range("R_net_a_payer")
        .Cells(i, 116) = Range("R_reglement")
        .Cells(i, 117) = Range("R_mail")
        .Cells(i, 118) = Range("G12")
        .Cells(i, 119) = Range("R_tiers1")

est bien enregistrer au bon endroit, et la boule elle est enregistrer sur la ligne portant le meme numero mais dans ma page recup et non dans ma base ai je oublier quelque chose ?

merci

Rechercher des sujets similaires à "enregistrement donnees"