Code vba à regarder
NonoM45 Messages postés 771 Date d'inscription Statut Membre Dernière intervention -
Bonjour à tous,
Débrouillardise comme je peux : un code est commencé mais cela ne fonctionne pas . Quelqu'un pourrait-il y regarder de plus près. ce serait gentil
Cela doit être une bêtise mais je ne comprends pas
Sub ajouter_modifier()
'module1
Dim ligne As Integer
ligne = 2
'vérifie si la cellule J7 de la feuille bdd = 0
If (Range(J7).Value = 0) Then
While Sheets("bdd").Cells(ligne, 3).Value <> ""
ligne = ligne + 1
Wend
MsgBox ligne
Sheets("bdd").Cells(ligne, 2).Value = Range("d23") ' Numero_id
Sheets("bdd").Cells(ligne, 3).Value = Range("b5") ' dte_inscription
Sheets("bdd").Cells(ligne, 4).Value = Range("b8") ' Civilité
Sheets("bdd").Cells(ligne, 5).Value = Range("b11") ' Nom
Sheets("bdd").Cells(ligne, 6).Value = Range("b14") ' Prénom
Sheets("bdd").Cells(ligne, 7).Value = Range("b17") ' prénom2
Sheets("bdd").Cells(ligne, 8).Value = Range("b20") ' date_naissance
Sheets("bdd").Cells(ligne, 9).Value = Range("b23") ' concat_N_P_P2
Sheets("bdd").Cells(ligne, 10).Value = Range("b27") ' Adresse
Sheets("bdd").Cells(ligne, 11).Value = Range("b30") ' complément_adresse
Sheets("bdd").Cells(ligne, 12).Value = Range("b34") ' numéro_B
Sheets("bdd").Cells(ligne, 13).Value = Range("b36") ' Code_postal
Sheets("bdd").Cells(ligne, 14).Value = Range("b38") ' Ville
Sheets("bdd").Cells(ligne, 15).Value = Range("b40") ' pays
Sheets("bdd").Cells(ligne, 16).Value = Range("b42") ' TélBfixe
Sheets("bdd").Cells(ligne, 17).Value = Range("bb44") ' TélBgsm
Sheets("bdd").Cells(ligne, 18).Value = Range("b46") ' TélBprof
Sheets("bdd").Cells(ligne, 19).Value = Range("d20") ' age
Sheets("bdd").Cells(ligne, 20).Value = Range("d5") ' poids
Sheets("bdd").Cells(ligne, 21).Value = Range("d8") ' taille
Sheets("bdd").Cells(ligne, 22).Value = Range("d11") ' Mail
Sheets("bdd").Cells(ligne, 23).Value = Range("d14") ' messenger
Sheets("bdd").Cells(ligne, 24).Value = Range("d17") ' WhatsApp
Sheets("bdd").Cells(ligne, 25).Value = Range("g34") ' numérof
Sheets("bdd").Cells(ligne, 26).Value = Range("g36") ' Code_postalf
Sheets("bdd").Cells(ligne, 27).Value = Range("g38") ' Villef
Sheets("bdd").Cells(ligne, 28).Value = Range("g40") ' paysf
Sheets("bdd").Cells(ligne, 29).Value = Range("g42") ' Télfixe_f
Sheets("bdd").Cells(ligne, 30).Value = Range("g44") ' Télgsm_f
Sheets("bdd").Cells(ligne, 31).Value = Range("g46") ' Télprof_f
Sheets("bdd").Cells(ligne, 32).Value = Range("b49") ' remarques générales
'efface contenu cellules du formulaire
Range("d23") = "" ' Numero_id
Range("b5") = "" ' dte_inscription
Range("b8") = "" ' Civilité
Range("b11") = "" ' Nom
Range("b14") = "" ' Prénom
Range("b17") = "" ' prénom2
Range("b20") = "" ' date_naissance
Range("b23") = "" ' concat_N_P_P2
Range("b27") = "" ' Adresse
Range("b30") = "" ' complément_adresse
Range("b34") = "" ' numéro_B
Range("b36") = "" ' Code_postal
Range("b38") = "" ' Ville
Range("b40") = "" ' pays
Range("b42") = "" ' TélBfixe
Range("bb44") = "" ' TélBgsm
Range("b46") = "" ' TélBprof
Range("d20") = "" ' age
Range("d5") = "" ' poids
Range("d8") = "" ' taille
Range("d11") = "" ' Mail
Range("d14") = "" ' messenger
Range("d17") = "" ' WhatsApp
Range("g34") = "" ' numérof
Range("g36") = "" ' Code_postalf
Range("g38") = "" ' Villef
Range("g40") = "" ' paysf
Range("g42") = "" ' Télfixe_f
Range("g44") = "" ' Télgsm_f
Range("g46") = "" ' Télprof_f
Range("b49") = "" ' remarques générales
Else
MsgBox "Tous les champs ne sont pas correctement renseignés"
End If
End Sub
End Sub
le fichier est joint.
Je souhaiterais effacer le bouton valider que je ne sais plus supprimer....
j'ai créé une numérotation automatique dans bdd sous la forme : =SI(B2="numero_ID";1;B2+1) comment faire pour voir apparaître ce numéro après enregistrement sur le formulaire dans la cellule et qu'il garde ce numéro toujours fixe même si filtre dans la bdd.
j'ai essayé de formater la cellule d11 mail comme ceci mais toujours le même problème bug !
via le ruban Données,Validation des données,
Personnalisé,
Formule
=ET(CHERCHE('@';D11)>0; CHERCHE('.';D11)>0; NBCAR(D11)>6)
comment retrouver un enregistrement par la variable nom concat_N_P_P2 et utiliser ces données dans un classeur 2 avec différentes feuilles reprenant les valeurs de ces données reprises sur le formulaire ?
Comment faire une macro vba pour passer de case en case à encoder sauf date inscription (b5), age (d20), ville (b38) et (g38) sans userform si possible
comment supprimer un enregistrement avec un message su style : Etes vous sûr(e) de vouloir supprimer ce patient ?
voilà toutes les questions que je me pose concernant ce formulaire.
Si quelqu'un pouvait m'aider, car là je ne vois plus cela dépasse mes petites compétences ?
merci bcp !
https://www.cjoint.com/c/MArl62fbAga
Windows / Chrome 109.0.0.0
- Code vba à regarder
- Code ascii - Guide
- Comment déverrouiller un téléphone quand on a oublié le code - Guide
- Code puk bloqué - Guide
- Regarder tv gratuitement sans télécharger - Guide
- Code activation windows 10 - Guide
3 réponses
Bonjour,
Vous avez changez de fichier?
Dans votre procedure:
2 end sub
Range(J7)----------------> Range("J7")
Bonjour,
Le code peut être largement optimisé, voici ce que l'on peut faire
Sub Ajouter_Modifier()
Dim Col As Long, ListeCel As String, TabCel() As String
Dim NewLig As Long
' vérifie si la cellule J7 du formualire <> 0
If ActiveSheet.Range("J7").Value <> 0 Then
MsgBox "Tous les champs ne sont pas correctement renseignés"
Exit Sub
End If
' Liste des celluls avec valeurs dans l'ordre des colonnes
ListeCel = "D23,B5,B8,B11,B14,B17,B20,B23,B27,B30,B34,B36,B38B40,B42,B44,B46,"
ListeCel = ListeCel & "D20,D5,D8,D11,D14,D17,G34,G36,G38,G40,G42gG44,G46,B49"
' Tableau des colonnes
TabCel = Split(ListeCel, ",")
' Sinon
With Sheets("bdd")
' Nouvelle ligne
NewLig = .Range("B" & Rows.Count).End(xlUp).Row + 1
' Pour chaque colonne
For Col = 0 To UBound(TabCel)
' Isncrire la valeur de la cellule de la liste
Sheets("bdd").Cells(NewLig, 2 + Col).Value = Sheets("formulaire").Range(TabCel(Col))
Next Col
'efface contenu cellules du formulaire
For Col = 0 To UBound(TabCel)
' Effacer la cellule
Range(TabCel(Col)).ClearContents
Next Col
End With
End Sub
A+
Bonjour Nono M45
Merci de votre réponse.
Je viens de tester votre code. Mais il y a un souci : la macro ne tient pas compte des cellules fusionnées ne les copie pas dans bdd et efface les données, formules, formats du formulaire
Je préfère rester sur mon code corrigé par f89409 (encore merci) même si pas clair pour les experts mais il copie les valeurs les cellules fusionnées et garde les formats et formules.
Merci d'y avoir passé du temps.
Pour celui ou celle que cela intéresserai
Petit correction du code précédent (il y avait 1 ou 2 coquilles ????)
Sub Ajouter_Modifier()
Dim Col As Long, ListeCel As String, TabCel() As String
Dim NewLig As Long
' vérifie si la cellule J7 du formualire <> 0
If ActiveSheet.Range("J7").Value <> 0 Then
MsgBox "Tous les champs ne sont pas correctement renseignés"
Exit Sub
End If
' Liste des celluls avec valeurs dans l'ordre des colonnes
ListeCel = "D23,B5,B8,B11,B14,B17,B20,B23,B27,B30,B34,B36,B38,B40,B42,B44,B46,"
ListeCel = ListeCel & "D20,D5,D8,D11,D14,D17,G34,G36,G38,G40,G42,G44,G46,B49"
' Tableau des colonnes
TabCel = Split(ListeCel, ",")
' Sinon
With Sheets("bdd")
' Nouvelle ligne
NewLig = .Range("B" & Rows.Count).End(xlUp).Row + 1
' Pour chaque colonne
For Col = 0 To UBound(TabCel)
' Isncrire la valeur de la cellule de la liste
Sheets("bdd").Cells(NewLig, 2 + Col).Value = Sheets("formulaire").Range(TabCel(Col)).Value
Next Col
'efface contenu cellules du formulaire
For Col = 0 To UBound(TabCel)
' Effacer la cellule
Range(TabCel(Col)).Value = ""
Next Col
End With
End Sub
Bonjour f894009,
Merci pour votre réponse.
non, je ne change pas de fichier comme j'ai du temps, j'ai essayé de construire qqchse où le raisonnement est plus clair.
j'expérimente excel. Vous remarquerez à la construction du code vba que je ne suis pas qq'un d'expérimenté. J'ai voulu tenter sans userform pour savoir jusqu'où je pouvais aller.
Merci
bien cordialement