Sujet Précédent Sujet Suivant

Code vba à regarder

Fermé
00_com Messages postés 21 Date d'inscription mercredi 27 juillet 2022 Statut Membre Dernière intervention 18 janvier 2023 - Modifié le 17 janv. 2023 à 13:12
NonoM45 Messages postés 566 Date d'inscription dimanche 14 juin 2009 Statut Membre Dernière intervention 27 novembre 2024 - 19 janv. 2023 à 04:28

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

A voir également:

3 réponses

Réponse 1 / 3
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
17 janv. 2023 à 14:28

Bonjour,

Vous avez changez de fichier?

Dans votre procedure:

2 end sub

Range(J7)----------------> Range("J7")
0
00_com Messages postés 21 Date d'inscription mercredi 27 juillet 2022 Statut Membre Dernière intervention 18 janvier 2023
18 janv. 2023 à 14:21

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 

0
Réponse 2 / 3
NonoM45 Messages postés 566 Date d'inscription dimanche 14 juin 2009 Statut Membre Dernière intervention 27 novembre 2024
18 janv. 2023 à 08:44

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+
0
00_com Messages postés 21 Date d'inscription mercredi 27 juillet 2022 Statut Membre Dernière intervention 18 janvier 2023
18 janv. 2023 à 14:22

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.

-1
Réponse 3 / 3
NonoM45 Messages postés 566 Date d'inscription dimanche 14 juin 2009 Statut Membre Dernière intervention 27 novembre 2024
19 janv. 2023 à 04:28

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
0

Discussions similaires

code d'activation GTA 5 steam
ylyes59 -
David -

6 réponses
Code de renvoi d'appel : Ooredo, Mobilis...
midoou07 -
Camille -

13 réponses