Pb code vba [Résolu]

Signaler
Messages postés
10
Date d'inscription
mercredi 23 janvier 2008
Statut
Membre
Dernière intervention
16 février 2011
-
Messages postés
10
Date d'inscription
mercredi 23 janvier 2008
Statut
Membre
Dernière intervention
16 février 2011
-
Bonjour,
Mon problème est que je veux transférer des numéros de téléphones d'un formulaire à une base de donnée.
J'aimerais que vous m'aidiez a trouver une solution alternative afin d'éviter que
- si j'ai rempli la cellule  E2
- puis 3 cases vides,
Que la valeur soit en E6 et pas en E3

J'explique en détail, mon formulaire peut recevoir jusqu'à 4 numéros de téléphone par personne, mais il n'est pas obligé de remplir  toutrs ces cases et je ne veux pas mettre comme numéro 0999999999... car le document est officiel.

 Je voudrais donc que: si la valeur de la cellule est vide, alors dans ma base apparaisse quelque chose.(solution qui me parait la plus simple)

mon code :

    Sheets("Fiches").Select
    Range("D17:G17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("base de donnée").Select
    valeurE2 = Range("E2").Value
       If valeurE2 = "" Then
        Range("E2").Select
    Else
        Range("E1").Select
        Selection.End(xlDown).Select
        ligne_active_base = ActiveCell.Row
        Range("E" & ligne_active_base + 1).Select
    End If
    ligne_active_base = ActiveCell.Row
    Range("E" & ligne_active_base).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

5 réponses

Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
Bonjour,

desole j'ai pas compris en quoi le faite d'avoir des celules vide te pose probleme ?
Avant que tu me reponde on vas en profiter pour simplifier et accelerer ton code:

Pour commencer pour travailler sur ou avec des celules tu n'as pas besoin de les selectionner cela accelere le code et eviter le clignotement de l'ecran

Dim DerniereValeur As Long, NbColonne As Long, MPplage As Range
Set MaPlage = Sheets("Fiches").Range("D17:G17")
DerniereValeur = Range("E:E").Find("*", , , , xlByRows, xlPrevious).Row 'renvoi le numero de la ligne qui contient la derniere valeur
NbColonne = MaPlage.Columns.Count 'compte le nombre de colonne dans MaPlage
Sheets("base de donnée").range(cells(DerniereValeur+1,1),cells(DerniereValeur+1,NbColonne)). value = MaPlage.value 'ici il est important que la plage de celules sources ai la meme taille et la meme forme que la plage de celules de destination
 
Comme tu peux le voir je ne fait pas de copy, ce code fait exactement la meme chose que le tient et sans rien selectioner.

A+
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
...
Moi aussi je ne suis pas expert en VBA. Ce n'est pas mon metier mais je me soigne ^^

Quand tu ajoutes un nouveau Nom avec son ou ses numeros, je suppose que le nouveau nom ce trouve sur la meme ligne que le/les numero(s) qui lui correpond ?
Donc dans tous les cas(si j'ai bien compris) tu as une liste de noms avec ou sans numero, vrai ?
"Re" donc meme si c'est un numero que tu veux ajouter, il faut faire une recherche sur les noms et pas sur les nemeros. Si le nom existe il suffit alors de verifier si il a deja un numero et si il en a deja 4, on stop la manipe
Autrement dit, il ne peu pas exister de numero sans nom.

Franchement je veux bien t'aider a remplire tes celules vides si tu insistes, mais je crois vraiment que tu es en train de faire une usine a gaz dans la quelle tu vas te perdre. Les celules vides ce gere tres bien avec excel avec ou sans macro. Et n'ai pas peur cela ne veut pas dire qu'il faut tout refaire.

Concretement pour t'aider j'ai besoin de savoir comment tu remplis ta feuille excel avec ton formulaire. Ton formulaire c'est un userform(sorte de boite de dialogue) ou une feuille excel ?
Essaye de m'expliquer le fonctionnement globale de ton projet.

Courrage

A+
Messages postés
10
Date d'inscription
mercredi 23 janvier 2008
Statut
Membre
Dernière intervention
16 février 2011

En fait, mon code entier est:

Sub Validation()


'Obliger a remplir les cases nécessaires à la base de donnéesIf Range("D11").Value "" Or Range("D12").Value "" Or Range("D7").Value = "" Or Range("D17").Value = "" Then MsgBox "Il faut impérativement remplir les cellules <Date de demande> <Nom du demandeur> <Telephone> Pour pouvoir continuer": Exit Sub




' Nom de Monsieur
    Sheets("Fiches").Select
    Range("D11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("base de donnée").Select
    valeurA2 = Range("A2").Value
    If valeurA2 = "" Then
        Range("A2").Select
    Else
        Range("A1").Select
        Selection.End(xlDown).Select
        ligne_active_base = ActiveCell.Row
        Range("A" & ligne_active_base + 1).Select
    End If
    ligne_active_base = ActiveCell.Row
    Range("A" & ligne_active_base).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
       
' Prénom de Monsieur
    Sheets("Fiches").Select
    Range("D12").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("base de donnée").Select
    valeurB2 = Range("B2").Value
    If valeurB2 = "" Then
        Range("B2").Select
    Else
        Range("B1").Select
        Selection.End(xlDown).Select
        ligne_active_base = ActiveCell.Row
        Range("B" & ligne_active_base + 1).Select
    End If
    ligne_active_base = ActiveCell.Row
    Range("B" & ligne_active_base).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
   
' Date de la Première demande
    Sheets("Fiches").Select
    Range("D7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("base de donnée").Select
    valeurC2 = Range("C2").Value
    If valeurC2 = "" Then
        Range("C2").Select
    Else
        Range("C1").Select
        Selection.End(xlDown).Select
        ligne_active_base = ActiveCell.Row
        Range("C" & ligne_active_base + 1).Select
    End If
    ligne_active_base = ActiveCell.Row
    Range("C" & ligne_active_base).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
 
' Date alerte =expiration - 7jours
    Sheets("Fiches").Select
    Range("K35").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("base de donnée").Select
    valeurD2 = Range("D2").Value
    If valeurD2 = "" Then
        Range("D2").Select
    Else
        Range("D1").Select
        Selection.End(xlDown).Select
        ligne_active_base = ActiveCell.Row
        Range("D" & ligne_active_base + 1).Select
    End If
    ligne_active_base = ActiveCell.Row
    Range("D" & ligne_active_base).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
     
' Téléphone
    Sheets("Fiches").Select
    Range("D17:G17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("base de donnée").Select
    valeurE2 = Range("E2").Value
       If valeurE2 = "" Then
        Range("E2").Select
    Else
        Range("E1").Select
        Selection.End(xlDown).Select
        ligne_active_base = ActiveCell.Row
        Range("E" & ligne_active_base + 1).Select
    End If
    ligne_active_base = ActiveCell.Row
    Range("E" & ligne_active_base).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
       
 'trier base de donnée
    Sheets("base de donnée").Select
    Columns("A:H").Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("A2") _
        , Order2:=xlAscending, Header:= _
        xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
    Sheets("Fiches").Select
   
    ThisWorkbook.Save
End Sub

J'ai testé ton code, en remplacement du mien et il bug (je ne suis pas expert en code VBA :p )


Le soucis avec ma ligne de code est que si la cellule D17 (telephone) est vide; alors lors de la prochaine inscription, le numéro de téléphone ne sera pas mis à la bonne personne, mais à la personne à qui je n'ai pas rentré de numéro.

A+
Messages postés
10
Date d'inscription
mercredi 23 janvier 2008
Statut
Membre
Dernière intervention
16 février 2011

Sur la même ligne, j'enregistre bien nom , prénom, date de demande, date d'expiration et numéro(s) de téléphone s'il y a  lieu.
Je t'aurai bien envoyer mon fichier pour que l'explication soit plus simple, mais je ne pense pas que ce soit possible par MP, donc j'envois ça sur ftp et je te file url par MP ;)

A+
Messages postés
10
Date d'inscription
mercredi 23 janvier 2008
Statut
Membre
Dernière intervention
16 février 2011

Un grand merci à toi qui a réussit là ou j'avais échoué

J'avais fait un message qui répondais à tes questions, mais j'ai mis un peu trop de temps à répondre, le site ne l'a pas accepté, dégouté ! lol

Mon problème avec les numéros de téléphone a été résolu avec ta modif.
Si tu as encore la feuille que j'ai up, tu pourra faire se test:
 - tu rentre Mr test  sans numéro de téléphone
 - puis tu rentre Mr test1 avec numéro de téléphone
 - tu remarquera, que le numéro de téléphone s'est ajouté à Mr test et pas a Mr test1

Sinon, je ne rentre pas toutes les infos car mon boss a peur de la taile de la base.
De plus, je sais envoyer des infos dans la base de données, mais je ne me suis pas encore renseigné pour faire un retour de ces infos dans la feuille vierge (on ne me l'a pas demandé non plus).
Mais il est possible que je m'y mette.

Par contre, je n'ai aps compris pourquoi tu a mis que ce n'étais pas terminé, le code me parait bon.
Sub MiseAJourDemandeurExistant()
    'pas terminé car la suite ce passera ici. Essaye de la cree par toi meme je t'aiderais volontier si tu as des problemes
    MsgBox "Existe deja en ligne " & Ligne
End Sub

Je te remercie encore une fois pour tout ce que tu as fait

A+