Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Création d'une fiche de saisie

Création d'une fiche de saisie

11 réponses
Avatar
sdellaux
en piece jointe mon dossier

http://cjoint.com/?fuqctTkB40

malgr=E9 mes recherches sur la FAQ, je n'arrive pas a creer une fiche de
saisie en VBA, le mode Grille existe certes mais n'est pas tres rapide
ou du moins ais=E9;
j'ai repris dans mon dossier joint l'ensemble des points que je
souhaite

merci d'avance pour votre contribution
st=E9phane
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
FFO
Salut sdellaux
Aprés avoir étudiér ton document
je te propose de tout piloter de ta feuille "BDG"
La création de la feuille de saisie en double cliquant sur la cellule H1
L'intégration dans la feuille "BDG" des saisies en double cliquant sur la
cellule N1 qui contiendra le nom de la feuille créée

Le code à mettre dans le VBA de la feuille "BDG" :

Private Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Cancel = True
If ActiveCell.Address = Range("H1").Address Then
Sheets.Add
Nom = ActiveSheet.Name
Sheets(Nom).Range("B1", "M1").Value = Sheets("BDG").Range("B2", "M2").Value
Sheets("BDG").Range("N1").Value = "CREER" & " " & Nom
End If

If ActiveCell.Address = Range("N1").Address Then
Onglet = Mid(Range("N1"), 7, Len(Range("N1")) - 6)
For I = 1 To Sheets.Count
If Sheets(I).Name = Onglet Then
ligne = Sheets(Onglet).Range("B65535").End(xlUp).Row
Sheets(Onglet).Range("A" & ligne, "M2").Copy
Range("B65535").End(xlUp).Offset(0, -1).Select
ActiveSheet.Paste
Range([B65535].End(xlUp).Offset(0, -1), [M3]).Select
Selection.Sort Key1:=Range("C3"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
Next
End If
End Sub

Je n'ai pas intégré l'ajout des colonnes car il me faut des précisions :

Où doivent elles être rajoutées (en début, en fin, aprés quelle colonne)
Ces colonnes doivent elles prises en compte dans l'intégrations des données
dans la feuille "BDG"

Testes déjà en l'état ce code et donnes moi tes impressions
1° double clique sur H1
2° réalise une saisie
3° double clique sur N1 de la feuille "BDG"

Au plaisir de te lire


en piece jointe mon dossier

http://cjoint.com/?fuqctTkB40

malgré mes recherches sur la FAQ, je n'arrive pas a creer une fiche de
saisie en VBA, le mode Grille existe certes mais n'est pas tres rapide
ou du moins aisé;
j'ai repris dans mon dossier joint l'ensemble des points que je
souhaite

merci d'avance pour votre contribution
stéphane




Avatar
sdellaux
merci de votre reponse en fait je reponds pour la deuxième fois le
premier ne semblant pas avoir ete pris en compte
ci joint le dossier de base auquel j'ai ajouté la macro que tu m'as
donné :
http://cjoint.com/?fvvDYzDHuI
probleme :
1 ok pour la création de la feuille de saisie mais qd j'appuis sur la
cellule n1 sur la feuille BDG j'ai un message d'erreur qui s'affiche,
mais les données sont qd memes inscrites ?

2- j'ai voulu saisir une deuxieme ligne de données : le message
d'erreur s'affiche toujours mais en plus les nouvelles données
remplacent celles qui ont ete positionnées lors de la première
saisie ???

Je dois faire je pense quelque par une mauvaise saisie ?

si je puis me permettre par rapport à ce que j'ai pu voir il
semblerait que pour chaque nouvelle saisie une nouvelle feuille de
saisie est crée et que la première est conservée, comme j'ai a peu
près 3700 timbres à saisir au bout d'un moment cela va etre impossible
deuxièmement est il possible de prévoir un parametrage de la feuille
de saisie identique à la BDG (Base de Données Générale) je parle de la
taille des caracteres de la largeur des colonnes etc.....

En ce qui concerne l'ajout de colonnes eventuelles elle seraient
ajoutées dans la BDG entre les colonnes K et L

Pour l'instant les seuls points que j'ai pu voir désolé de mettre a
epreuve ta patiente mais pour plaisanter un peu j'ai trouvé une
nouvelle signification au sigle VBA :
Vais Bientot y Arriver....
cordialement
stéphane
Avatar
FFO
Re Bonjours sdellaux
Au regard donc de tes remarques effectivement une coquille s'était glissée
dans mon code qui avait pour inconvénient dans la recopie des données Onglet
"BDG"
au lieu de se rajouter d'écraser la dernière saisie
J'ai apporté la modification appropriée ainsi que toutes celles
correspondantes à l'ensemble des améliorations que tu m'as formulé notamment
en vue des colonnes à rajouter
J'ai donc intégré notamment la suppression de la feuille aprés intégration
de la saisie dans "BDG"
Il est donc important d'actionner la cellule "CREER Feuilx" à bonne escient
car la feuille en correspondance aura disparu aprés

Concernant les colonnes à rajouter Onglet "BDG" entre les colonnes K et L
Si cette action doit être occasionnelle je ne peux l'intégrer dans ce code
car à chaque utilisation ce rajout serait effectué
Je ne penses pas que c'est celà que tu souhaites
Seule solution prendre une nouvelle cellule à activer comme H1 pour à la
demande les rajouter
Maintenant n'est il pas plus simple de le réaliser manuellement en
selectionnant la colonne L et en effectuant Insertion/Colonne
Merci de me donner ton avis
Attention le rajout des colonnes déplacera la cellule correspondant à
l'action "CREER Feuilx"
Fort de toutes ces explications en lieu et place de mon dernier code :

Private Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
Cancel = True
If ActiveCell.Address = Range("H1").Address Then
Sheets.Add
Nom = ActiveSheet.Name
Sheets(Nom).Range("B1").EntireRow.Value =
Sheets("BDG").Range("B2").EntireRow.Value
Sheets("BDG").Range("IV1").End(xlToLeft).Value = "CREER" & " " & Nom
End If


If ActiveCell.Address = Range("IV1").End(xlToLeft).Address Then
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse,
Tab:=True, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:úlse,
FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Onglet = Mid(Range("N1"), 7, Len(Range("N1")) - 6)
For I = 1 To Sheets.Count
If Sheets(I).Name = Onglet Then
ligne = Sheets(Onglet).Range("B65535").End(xlUp).Row
Sheets(Onglet).Range("A" & ligne).EntireRow.Copy
Range("B65535").End(xlUp).Offset(1, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).EntireRow.Copy
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
Range([B65535].End(xlUp).Offset(0, -1), [A3]).EntireRow.Select
Selection.Sort Key1:=Range("C3"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
Next
Application.DisplayAlerts = False
Sheets(Onglet).Select
ActiveWindow.SelectedSheets.Delete
End If
End Sub

Donne moi tes impressions
Dans l'attente


merci de votre reponse en fait je reponds pour la deuxième fois le
premier ne semblant pas avoir ete pris en compte
ci joint le dossier de base auquel j'ai ajouté la macro que tu m'as
donné :
http://cjoint.com/?fvvDYzDHuI
probleme :
1 ok pour la création de la feuille de saisie mais qd j'appuis sur la
cellule n1 sur la feuille BDG j'ai un message d'erreur qui s'affiche,
mais les données sont qd memes inscrites ?

2- j'ai voulu saisir une deuxieme ligne de données : le message
d'erreur s'affiche toujours mais en plus les nouvelles données
remplacent celles qui ont ete positionnées lors de la première
saisie ???

Je dois faire je pense quelque par une mauvaise saisie ?

si je puis me permettre par rapport à ce que j'ai pu voir il
semblerait que pour chaque nouvelle saisie une nouvelle feuille de
saisie est crée et que la première est conservée, comme j'ai a peu
près 3700 timbres à saisir au bout d'un moment cela va etre impossible
deuxièmement est il possible de prévoir un parametrage de la feuille
de saisie identique à la BDG (Base de Données Générale) je parle de la
taille des caracteres de la largeur des colonnes etc.....

En ce qui concerne l'ajout de colonnes eventuelles elle seraient
ajoutées dans la BDG entre les colonnes K et L

Pour l'instant les seuls points que j'ai pu voir désolé de mettre a
epreuve ta patiente mais pour plaisanter un peu j'ai trouvé une
nouvelle signification au sigle VBA :
Vais Bientot y Arriver....
cordialement
stéphane





Avatar
sdellaux
re et encore désolé
j'ai bien recopier le nouveau code
mais il y plein de lignes qui s'affichent en rouge
"erreur de compilation"
je crois savoir que cela provient d'espaces ou autres signes qui se
recopient mal
et je n'arrive pas malgré plusieurs essais a éliminer les erreurs de
compilation
je joins le fichier pour que tu puisses voir toute ces anomalies
je n'ai rien pu faire d'autre vu toutes ces anomalies
cordialement
stéphane
Avatar
sdellaux
désolé omission de joindre le fichier
voilà qui est fait

http://cjoint.com/?fwqRXrrDEs

cordialement
stéphane
Avatar
FFO
ReBonjours sdellaux
Il est normal lorsque l'on recopie le code à partir de ce que je te
transmets qu'il y est des lignes en rouge
La recopie ne se réalise pas exactement à l'identique notamment sur leur
présentation
Certaines d'entre elles sont scindées en 2 lignes interprété par le VBA pour
2 instructions différentes alors qu'il n'y en a qu'une
Solution :
soit tu corriges ainsi :
portes toi en bout de la première ligne rouge et réalise un suppr pour
ramener la ligne suivante en bout de celle-ci
Renouvelles l'opération ainsi autant de fois que nécessaire
Il ne doit plus percister de ligne rouge

Sinon je te propose ce code identique au précédent mais avec un caractère
supplémentaire pour unir les lignes scindées
Tu ne devrais plus avoir ce type de difficulté à la recopie :

Private Sub WorkSheet_BeforeDoubleClick(ByVal Target As Range, Cancel As _
Boolean)
Cancel = True
If ActiveCell.Address = Range("H1").Address Then
Sheets.Add
Nom = ActiveSheet.Name
Sheets(Nom).Range("B1").EntireRow.Value = _
Sheets("BDG").Range("B2").EntireRow.Value
Sheets("BDG").Range("IV1").End(xlToLeft).Value = "CREER" & " " & Nom
End If
If ActiveCell.Address = Range("IV1").End(xlToLeft).Address Then
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse, _
Tab:=True, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:úlse, _
FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
Onglet = Mid(Range("N1"), 7, Len(Range("N1")) - 6)
For I = 1 To Sheets.Count
If Sheets(I).Name = Onglet Then
ligne = Sheets(Onglet).Range("B65535").End(xlUp).Row
Sheets(Onglet).Range("A" & ligne).EntireRow.Copy
Range("B65535").End(xlUp).Offset(1, -1).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 0).EntireRow.Copy
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:úlse, Transpose:úlse
Range([B65535].End(xlUp).Offset(0, -1), [A3]).EntireRow.Select
Selection.Sort Key1:=Range("C3"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End If
Next
Application.DisplayAlerts = False
Sheets(Onglet).Select
ActiveWindow.SelectedSheets.Delete
End If
End Sub

Reste plus qu'à réaliser les essais
Dis moi !!!


re et encore désolé
j'ai bien recopier le nouveau code
mais il y plein de lignes qui s'affichent en rouge
"erreur de compilation"
je crois savoir que cela provient d'espaces ou autres signes qui se
recopient mal
et je n'arrive pas malgré plusieurs essais a éliminer les erreurs de
compilation
je joins le fichier pour que tu puisses voir toute ces anomalies
je n'ai rien pu faire d'autre vu toutes ces anomalies
cordialement
stéphane





Avatar
jps
bonjour stéphane
je vois pourquoi tes lignes sont en rouge : pb de coupure de ligne
veux-tu que je les rectifie.
à suivre
cordialement
jps

"sdellaux" a écrit dans le message de news:


désolé omission de joindre le fichier
voilà qui est fait

http://cjoint.com/?fwqRXrrDEs

cordialement
stéphane
Avatar
sdellaux
Oui je veux bien que tu les rectifies je n'y suis pas arrivé
cordialement
stéphane

On 22 mai, 17:55, "jps" wrote:
bonjour stéphane
je vois pourquoi tes lignes sont en rouge : pb de coupure de ligne
veux-tu que je les rectifie.
à suivre
cordialement
jps

"sdellaux" a écrit dans le message de news:


désolé omission de joindre le fichier
voilà qui est fait

http://cjoint.com/?fwqRXrrDEs



Avatar
sdellaux
Re j'ai repris donc le nouveau code
à la premiere saisie lorsque je valide j'ai message erreur de débogage
et les lignes suivantes sont surlignées en jaunes

Selection.TextToColumns Destination:=Range("C1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:úlse, _
Tab:=True, _
Semicolon:úlse, Comma:úlse, Space:úlse, Other:úlse, _
FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Que se passe t il ?
vraiment désolé pour tous ces contre temps
cordialement
stéphane
Avatar
FFO
Rebonjours sdellaux
C'est gentil de la part de jps de t'apporter les corrections liées au
dédoublement de certaines lignes engendré par le copier/coller de mauvaise
qualité
Mais j'inciste sur la possibilité pour toi de récupérer le dernier code
transmis par mes soins (Post du 22/05/2007 08:09) qui te permettra une
recopie sans anomalie et un fonctionnement sans histoire

Tu peux donc sans crainte l'utiliser et faire tes essais

Fais moi part te ton ressenti


Oui je veux bien que tu les rectifies je n'y suis pas arrivé
cordialement
stéphane

On 22 mai, 17:55, "jps" wrote:
bonjour stéphane
je vois pourquoi tes lignes sont en rouge : pb de coupure de ligne
veux-tu que je les rectifie.
à suivre
cordialement
jps

"sdellaux" a écrit dans le message de news:


désolé omission de joindre le fichier
voilà qui est fait

http://cjoint.com/?fwqRXrrDEs









1 2