Archivage formulaire + incrementation numero + nouveau formulaire

eve98 · Juin 24, 2018, 11:07am

bonjour je me suis servie du totu “Modèle de facture avec incrémentation automatique du numéro - Docteur Excel” pour mon document mais cela ne fonctionne pas.

voici mon code :
Sub archiver_et_nouveau_formulaire()

ligne = Sheets(“Historique_formulaire”).Range(“A4”).End(xlDown).Row + 1

Sheets(“Historique_formulaire”).Range(“A” & ligne).Value = Sheets(“Formulaire”).Range(“C2”).Value
Sheets(“Historique_formulaire”).Range(“B” & ligne).Value = Sheets(“Formulaire”).Range(“E4:F4”).Value
Sheets(“Historique_formulaire”).Range(“C” & ligne).Value = Sheets(“Formulaire”).Range(“I4:L4”).Value
Sheets(“Historique_formulaire”).Range(“D” & ligne).Value = Sheets(“Formulaire”).Range(“E5:F5”).Value
Sheets(“Historique_formulaire”).Range(“E” & ligne).Value = Sheets(“Formulaire”).Range(“I5:L5”).Value
Sheets(“Historique_formulaire”).Range(“F” & ligne).Value = Sheets(“Formulaire”).Range(“E6:F6”).Value
Sheets(“Historique_formulaire”).Range(“G” & ligne).Value = Sheets(“Formulaire”).Range(“I6:L6”).Value
Sheets(“Historique_formulaire”).Range(“H” & ligne).Value = Sheets(“Formulaire”).Range(“I7:L7”).Value
Sheets(“Historique_formulaire”).Range(“I” & ligne).Value = Sheets(“Formulaire”).Range(“E7:F7”).Value
Sheets(“Historique_formulaire”).Range(“J” & ligne).Value = Sheets(“Formulaire”).Range(“E8”).Value
Sheets(“Historique_formulaire”).Range(“K” & ligne).Value = Sheets(“Formulaire”).Range(“J8:L8”).Value
Sheets(“Historique_formulaire”).Range(“L” & ligne).Value = Sheets(“Formulaire”).Range(“L13:M13”).Value
Sheets(“Historique_formulaire”).Range(“M” & ligne).Value = Sheets(“Formulaire”).Range(“L15:M15”).Value
Sheets(“Historique_formulaire”).Range(“N” & ligne).Value = Sheets(“Formulaire”).Range(“L19:M19”).Value
Sheets(“Historique_formulaire”).Range(“O” & ligne).Value = Sheets(“Formulaire”).Range(“L22:M22”).Value
Sheets(“Historique_formulaire”).Range(“P” & ligne).Value = Sheets(“Formulaire”).Range(“L37:M37”).Value
Sheets(“Historique_formulaire”).Range(“Q” & ligne).Value = Sheets(“Formulaire”).Range(“L39:M39”).Value
Sheets(“Historique_formulaire”).Range(“R” & ligne).Value = Sheets(“Formulaire”).Range(“L43:M43”).Value
Sheets(“Historique_formulaire”).Range(“S” & ligne).Value = Sheets(“Formulaire”).Range(“L45:M45”).Value
Sheets(“Historique_formulaire”).Range(“U” & ligne).Value = Sheets(“Formulaire”).Range(“E48:H48”).Value
Sheets(“Historique_formulaire”).Range(“V” & ligne).Value = Sheets(“Formulaire”).Range(“E51:H51”).Value

Sheets(“Formulaire”).Range(“E13:E15”).ClearContents
Sheets(“Formulaire”).Range(“E19:E33”).ClearContents
Sheets(“Formulaire”).Range(“E37”).ClearContents
Sheets(“Formulaire”).Range(“E43”).ClearContents
Sheets(“Formulaire”).Range(“G13:G15”).ClearContents
Sheets(“Formulaire”).Range(“G19:G33”).ClearContents
Sheets(“Formulaire”).Range(“G37”).ClearContents
Sheets(“Formulaire”).Range(“G43”).ClearContents

Sheets(“Formulaire”).Range(“C2”).Value = Sheets(“Formulaire”).Range(“C2”).Value + 1

End Sub

uand j essaie de le lancer j’ai un message “erreur execution 1004
erreur definie par l"application ou par l’objet”

pouvez vous m’aider?

Mimimathy · Juin 24, 2018, 11:15am

Bonjour,
Plutôt que de mettre un code macro
placez plutôt un classeur exemple

eve98 · Juin 24, 2018, 11:27am

en fait j ai un formulaire dans un page et je veux sauvegarder certaines données dans un tableau situé dans un second onglet…

je ne comprends pas votre réponse…fiche de remboursement 2.xlsm (32,8 Ko)

Mimimathy · Juin 24, 2018, 11:22am

Re,

Ton formulaire est dans une page --> ok
La page est dans un classeur Excel --> ok

Prend ce classeur Excel et place le en pièces jointes

eve98 · Juin 24, 2018, 11:31am

merci…j’ai effectivement joint mon fichier…ce sera plus compréhensible pour vous.

j’avoue que j’ai déjà pas mal travaillé dessus au point de vue formule.
En effet, le formulaire fait référence à des formules placées dans un onglet différent (que j’ai oublié de copier dans le ficher envoyé) mais cela n’est pas nécessaire pour résoudre mon souci.

Je pense que c’est vraiment un pb de code VBA. Je débute alors j’utilise des tutos en faisant bien attention aux formules…mais cela ne reste pas évident. En l’espèce j’ai bien suivi les indication du tuto que j’ai indiqué, mais cela ne fonctionne pas et je ne sais pas pourquoi.

en tout cas merci de votre aide

eve

Mimimathy · Juin 24, 2018, 11:34am

Re

Ok, ce sera plus facile à résoudre
Je regarde cela (plus tard - Ce soir et demain matin)
et je tient au courant

eve98 · Juin 24, 2018, 11:35am

ok merci merci beaucoup…vous êtes ma lueur d’espoir !
je n’en pouvais plus de ce casse tête.

eve

Mimimathy · Juin 24, 2018, 11:45am

Re,

Juste à première vue avec le classeur
Testé cette ligne à la place de l’autre (1ere ligne de la macro)

ligne = Sheets("Historique_formulaire").Range("A" & Rows.Count).End(xlUp).Row + 1

au lieu de

ligne = Sheets("Historique_formulaire").Range("A4").End(xlDown).Row + 1

eve98 · Juin 24, 2018, 8:59pm

effectivement cela fonctionne…mais cela ne sauvegarde par toutes les données et n’efface pas le formulaire une fois archiver.
c’est déjà un grand début !!

Mimimathy · Juin 25, 2018, 4:46am

Bonjour,

A tester

La macro revisitée :

Option Explicit

Sub archiver_et_nouveau_formulaire()
  'Déclaration des variables
  Dim Ws As Worksheet, Wd As Worksheet
  Dim ligne%
  'Affectation des variables
  Set Ws = Sheets("Formulaire") 'Ws pour Worksheet sourse
  Set Wd = Sheets("Historique_formulaire") 'Ws pour Worksheet destination
  ligne = Wd.Range("A" & Rows.Count).End(xlUp).Row + 1 'première ligne vide depuis le haute de la colonne A
  'Copie les données
  Wd.Range("A" & ligne).Value = Ws.Range("C2").Value
  Wd.Range("B" & ligne).Value = Ws.Range("E4:F4").Value
  Wd.Range("C" & ligne).Value = Ws.Range("I4:L4").Value
  Wd.Range("D" & ligne).Value = Ws.Range("E5:F5").Value
  Wd.Range("E" & ligne).Value = Ws.Range("I5:L5").Value
  Wd.Range("F" & ligne).Value = Ws.Range("E6:F6").Value
  Wd.Range("G" & ligne).Value = Ws.Range("I6:L6").Value
  Wd.Range("H" & ligne).Value = Ws.Range("I7:L7").Value
  Wd.Range("I" & ligne).Value = Ws.Range("E7:F7").Value
  Wd.Range("J" & ligne).Value = Ws.Range("E8").Value
  Wd.Range("K" & ligne).Value = Ws.Range("J8:L8").Value
  Wd.Range("L" & ligne).Value = Ws.Range("L13:M13").Value
  Wd.Range("M" & ligne).Value = Ws.Range("L15:M15").Value
  Wd.Range("N" & ligne).Value = Ws.Range("L19:M19").Value
  Wd.Range("O" & ligne).Value = Ws.Range("L22:M22").Value
  Wd.Range("P" & ligne).Value = Ws.Range("L37:M37").Value
  Wd.Range("Q" & ligne).Value = Ws.Range("L39:M39").Value
  Wd.Range("R" & ligne).Value = Ws.Range("L43:M43").Value
  Wd.Range("S" & ligne).Value = Ws.Range("L45:M45").Value
  Wd.Range("U" & ligne).Value = Ws.Range("E48:H48").Value
  Wd.Range("V" & ligne).Value = Ws.Range("E51:H51").Value
  'Efface les données
  Ws.Range("E4:F7,E8,I4:L7,J8:L8,E13:E15,E19:E33,E37,E43,G13:G15,G19:G33,G37,G43").ClearContents
  'Incrémente le N° de fiche
  Ws.Range("C2").Value = Ws.Range("C2").Value + 1
End Sub

fiche de remboursement 2.xlsm (29,8 Ko)

eve98 · Juin 25, 2018, 9:57am

hello

j’ai pu tester et j ai une message d’erreur de debogage à la ligne:
'Efface les données
Ws.Range(“E4:F7,E8,I4:L7,J8:L8,E13:E15,E19:E33,E37,E43,G13:G15,G19:G33,G37,G43”).ClearContents
cela n’efface rien du tout…
par contre si je place mes anciens codes concernant la suppression des données, cela fonctionne

eve

Mimimathy · Juin 25, 2018, 10:59am

Bonjour,
Peut-être que ta version Excel ne prend pas en charge les “Range” multiple
Dans ce cas remplace par ceci la ligne en cause

'Efface les données
  Ws.Range("E4:F7").ClearContents
  Ws.Range("E8").ClearContents
  Ws.Range("I4:L7").ClearContents
  Ws.Range("J8:L8").ClearContents
  Ws.Range("E13:E15").ClearContents
  Ws.Range("E19:E33").ClearContents
  Ws.Range("E37").ClearContents
  Ws.Range("E43").ClearContents
  Ws.Range("G13:G15").ClearContents
  Ws.Range("G19:G33").ClearContents
  Ws.Range("G37,G43").ClearContents

eve98 · Juin 25, 2018, 10:04pm

impeccable !! m’enfin presque.
tout fonctionne bien = les données sont implémentées dans le tableau ET cela efface bien le formulaire…
merci beaucoup pour ces nouvelles formules qui effectivement fonctionnent mieux

MAIS cela efface mes formules dans la colonne grisée sur le côté droit…je ne sais pas pourquoi. A chaque fois que j’utilise le bouton d’archivage…mon formulaire perd 10 formules seulement. celles de droite et les deux du bas.
A chaque fois je suis obligée de les réecrire.

vous savez pourquoi cela efface ces formules la?

eve98 · Juin 25, 2018, 10:06pm

je crois que c’est le .ClearContents qui efface le contenu resultat et formule alors que je ne veux qu’effacer le résultat sans toucher a la formule.
il doit y avoir un autre code pour cela, non?

Mimimathy · Juin 26, 2018, 5:02am

Bonjour,

Je ne vois pas,
précise quel cellule

eve98 · Juin 26, 2018, 8:24am

ce sont les cellules L13:M13, L15:M15, L19:M19, … les cellules de calcul dans la colonne grise et celles du bas E48:H48 E51:H51 qui sont des cellules de recap

Mimimathy · Juin 26, 2018, 8:27am

Re,
Désolé, chez moi les formules sont toujours là après validation
De plus la macro ne les effacent pas

eve98 · Juin 26, 2018, 9:07am

hello

mon code :
Sub archiver_et_nouveau_formulaire()

'Déclaration des variables
Dim Ws As Worksheet, Wd As Worksheet
Dim Ligne%

'Affectation des variables
Set Ws = Sheets(“Formulaire”) 'Ws pour Worksheet sourse
Set Wd = Sheets(“Historique_formulaire”) 'Ws pour Worksheet destination
Ligne = Wd.Range(“A” & Rows.Count).End(xlUp).Row + 1 'première ligne vide depuis le haute de la colonne A

'Copie les données
Wd.Range(“A” & Ligne).Value = Ws.Range(“D4”).Value
Wd.Range(“B” & Ligne).Value = Ws.Range(“E6:F6”).Value
Wd.Range(“C” & Ligne).Value = Ws.Range(“I6:L6”).Value
Wd.Range(“D” & Ligne).Value = Ws.Range(“E7:F7”).Value
Wd.Range(“E” & Ligne).Value = Ws.Range(“I7:L7”).Value
Wd.Range(“F” & Ligne).Value = Ws.Range(“E8:F8”).Value
Wd.Range(“G” & Ligne).Value = Ws.Range(“I8:L8”).Value
Wd.Range(“H” & Ligne).Value = Ws.Range(“I9:L9”).Value
Wd.Range(“I” & Ligne).Value = Ws.Range(“E9:F9”).Value
Wd.Range(“J” & Ligne).Value = Ws.Range(“E10:F10”).Value
Wd.Range(“K” & Ligne).Value = Ws.Range(“J10:L10”).Value
Wd.Range(“L” & Ligne).Value = Ws.Range(“L15”).Value
Wd.Range(“M” & Ligne).Value = Ws.Range(“L17”).Value
Wd.Range(“N” & Ligne).Value = Ws.Range(“L21”).Value
Wd.Range(“O” & Ligne).Value = Ws.Range(“L23”).Value
Wd.Range(“P” & Ligne).Value = Ws.Range(“L39”).Value
Wd.Range(“Q” & Ligne).Value = Ws.Range(“L41”).Value
Wd.Range(“R” & Ligne).Value = Ws.Range(“L49”).Value
Wd.Range(“S” & Ligne).Value = Ws.Range(“L51”).Value
Wd.Range(“U” & Ligne).Value = Ws.Range(“E54:H54”).Value
Wd.Range(“V” & Ligne).Value = Ws.Range(“E57:H57”).Value

'Efface les données
Ws.Range(“E6:F6”).ClearContents
Ws.Range(“I6:L6”).ClearContents
Ws.Range(“E7:F7”).ClearContents
Ws.Range(“I7:L7”).ClearContents
Ws.Range(“E8:F8”).ClearContents
Ws.Range(“I8:L8”).ClearContents
Ws.Range(“E9:F9”).ClearContents
Ws.Range(“E10:F10”).ClearContents
Ws.Range(“J10:L10”).ClearContents

Ws.Range(“L15”).ClearContents
Ws.Range(“L17”).ClearContents
Ws.Range(“L21”).ClearContents
Ws.Range(“L23”).ClearContents
Ws.Range(“L39”).ClearContents
Ws.Range(“L41”).ClearContents
Ws.Range(“L49”).ClearContents
Ws.Range(“L51”).ClearContents
Ws.Range(“E54:H54”).ClearContents
Ws.Range(“E57:H57”).ClearContents

Ws.Range(“E15:E17”).ClearContents
Ws.Range(“G15:G17”).ClearContents
Ws.Range(“E21:E35”).ClearContents
Ws.Range(“E39:E43”).ClearContents
Ws.Range(“G21:G35”).ClearContents
Ws.Range(“G39:G43”).ClearContents
Ws.Range(“E49,G49”).ClearContents

'Incrémente le N° de fiche
Ws.Range(“D4”).Value = Ws.Range(“D4”).Value + 1

End Sub

seules les lignes avec les puces m’effacent les formules a chaque fois que je fais jouer la macro…
les données sont bien copiées dans le second onglet mais lorsque je reviens sur le formulaire les formules de ces quelques lignes ont disparus…Classeur1.xlsx (22,2 Ko)

Mimimathy · Juin 26, 2018, 9:24am

Re,

Normal, puisque ces lignes effacent tout les données
Mais ces lignes viennent de qui ???

Il te suffit de les supprimer et cela rentrera dans l’ordre, du moins peut-être
car entre le premier classeur que tu donnes et le dernier, des cellules ne sont plus fusionnées

eve98 · Juin 26, 2018, 9:48pm

hello

je t’envoi le fichier avec tout les onglets (tables et autres…) afin que tu puisses mieux te rendre compte.
J’ai effectivement modifier mon fichier et mis une cellule unique parce que j 'ai bêtement pensé que c’était cela le problème…mais non

le fichier est finalisé, il n’y aura plus aucune modification de forme ou de cellule.

comme tu le constatera mes deux soucis sont :
1/ les formules des cellules :L15, L17, L21, L23, L39, L41, L49, L51, E54 et E57 s’effacent lorsque je fais tourner la macro du bouton archiver et creation nouveau formulaire
2/ pas d’enregistrement dons mon fichier Z/Documentation…

fiche de remboursement type pour demo.xlsm (49,5 Ko)

Désolée d’avoir créer une deuxième boite de discussion mais je pensais que séparer les deux permettrait aux personnes désirant une info en particulier de la trouver plus rapidement.

je te remercie grandement de ton aide et ton support. je vois de la lumiere au bout du tunnel

eve