Enregistrement dans une base
bonsoir actuellement j'ai pour enregistrer le contenu d'un tableau appelé recup le code suivant:
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
Range("R_reglement").Select
Exit Sub
End If
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")
.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")
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 Subqui lorsque le numero du document n'existe pas enregistre les données sur une ligne dans une base choisi de manière pleinne et entière. et cela fonctionne bien par contre si le n° de documents est deja dans la base il ne fait pas la mise a jours des donnée si celle-ci on ete modifier.
ce que je cherche a faire en quelques mots
si le document n'existe pas on l'enregistre a la suite (la ca marche)
si le document existe on enregistre les donnée qui on été modifier
et si le document est une facture un message la facture ne peut pas etre modifier et on n'enregistre rien.
mon fichier en suivant et merci par avance
grace a mon travail sur d'autre code j'ai fini par trouver la solution
merci a vous.
le bout de code qui me manquais est :
Dim i As Integer, j As String
Dim cel As Range
If Me.ComboBox2.Value = "bon de commande" Then
With Sheets("base_commande")
Set cel = .Columns("A").Find(What:=Me.TextBox1, LookIn:=xlValues, Lookat:=xlWhole)
If Not cel Is Nothing Then
i = cel.Row
Else
MsgBox "le numero de bon de commande n'existe pas, ou est incomplet veuillez le re-saisir merci"
Me.TextBox1.SetFocus
Exit Sub
' puis saisir les infos de destinationsi cela peut vous servir c'est avec le plus grand plaisir