Résolu Excel Macro et VB

  • Auteur de la discussion picpic62
  • Date de début

picpic62

Nouveau membre
Bonjour,
J'ai quelques problèmes avec Excel. Je dois générer plus ou moins 4000 fiches qui comportent chacune 6 champs de saisie. Mais je n'ai pas d'expérience en ce qui concerne les macro et encore moins en ce qui concerne VB.
Voici mon problème:
J'ai une "fiche" type (vierge) qui comporte les 6 champs à remplir. J'ai un autre document excel avec les données (rangées dans un tableau) à insérer dans chaque fiche (une ligne du tableau correspond à une fiche).
Pour le moment, j'ai trouver ces lignes-ci pour enregistrer les pg excel:

Code:
Public Sub CommandButton1_Click() 'copie sauvegarde classeur 
Dim nom As String 
nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & ActiveWorkbook.Name 
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom 
rep = MsgBox("Votre base de données est sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur") 
End Sub

Mais je n'ai pas besoin de la date dans le nom du document il me faudrait une incrémentation (1,2,3...) et pas de bouton sinon faut que j'ouvre les 4000 fiches :S.

J'ai aussi créé la macro suivante:

Code:
Sub Remplissage() 
' 
' Remplissage Macro 
' 

' 
Range("C8").Select 
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C5" 
Range("F8").Select 
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C4" 
Range("J8").Select 
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C9" 
Range("C13").Select 
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C1" 
Range("G13").Select 
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C2" 
Range("J13").Select 
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C3" 
Range("J14").Select 
End Sub

Qui elle sert juste a affecter la valeur au champ de la fiche à partir du tableau contenu dans le 2eme document.

Ce que je voudrait faire, c'est une boucle while qui répette ces tâches en incrémentant (pour passer à la ligne suivante du tableau) en enregistrant chaque fois la fiche avec le nom et le n°.

Je sais pas si j'ai été assez claire?

Je vous remercie de pretter attention à mon problème.
 

zeb

Modérateur
A la lecture de ton message : Et hop, encore un qui confond EXCEL avec un gestionnaire de base de données.

Non mais, 4000 fiches !

Code:
Sub ExcelAsDB()
    Dim t As Balloon
    Assistant.On = True
    Set t = Assistant.NewBalloon
    t.Animation = 11
    t.Button = 1
    t.Heading = StrReverse(".ruelbat nu tse lecxE" )
    t.Text = StrReverse(".seénnod ed esab ed eriannoitseg nu sap tse'n eC" )
    t.Show
    Assistant.Visible = False
    Set t = Nothing
    Assistant.On = False
End Sub

_____________________________________________________


On t'oblige à utiliser Excel ?
Bon aller, un peu d'aide tout de même...
 

zeb

Modérateur
Code:
Public Sub CommandButton1_Click() 'copie sauvegarde classeur
	Dim nom As String

	nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & ActiveWorkbook.Name
	ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nom
	rep = MsgBox("Votre base de données est sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur" )
End Sub
Bon, pas mal.

Cependant, je t'engage à ne pas trop te servir des objets actifs. Excel étant parfois espiègle, il changera inopinément l'objet actif en cours. Donc, quand tu en tiens un (un objet actif), pointe dessus avec une variable pour pouvoir d'y référer ensuite :
Code:
Public Sub CommandButton1_Click() 'copie sauvegarde classeur
	Dim nom As String
	Dim wk As Workbook
	
	Set wk = ActiveWorkbook
	
	nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & wb.Name
	wb.SaveCopyAs wb.Path & "\" & nom
	
	rep = MsgBox("Votre base de données est sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur" )
End Sub
Tu ne déclares pas rep. C'est mal. C'est très mal ! Ose me dire que tu n'as pas mis Option Explicit au début de ton code !!!! [:zeb:4]
En plus, pourquoi ce rep puisque tu ne t'en sers pas !
Code:
Public Sub CommandButton1_Click() 'copie sauvegarde classeur
	Dim nom As String
	Dim wk As Workbook
	
	Set wk = ActiveWorkbook
	
	nom = Day(Date) & "-" & Month(Date) & "-" & Year(Date) & "_" & wb.Name
	wb.SaveCopyAs wb.Path & "\" & nom
	
    MsgBox "Vos données seraient mieux dans un vrai SGBD ! " & vbCrLf & _
           "En attendant, les voilà sauvées dans : " & nom, _
           vbYes + vbInformation, _
           "Copie sauvegarde classeur"
End Sub
 

picpic62

Nouveau membre
Merci pour ces quelques infos,
En réalité, j'ai pompé le code tout fait sur le net et je l'ai laissé tel quel pour le moment. Mais c'est vrai que je n'ai pas besoin de rep.
C'est quoi SGBD?

 

zeb

Modérateur
Alors, c'est cool. A part que ce n'est pas ce que tu veux ^^
Tu veux un nom avec un numéro.

Ben le voilà le numéro :
Code:
Dim Numero As Integer
Numero = 1

Bon, alors pour numéroter un fichier, c'est très facile sur le papier :

Code:
C:\chemin\fichier.extention
                 |
                 `- ajouter là le numéro.
C:\chemin\fichier_numéro.extention

Bref, il faut éclater le nom complet du ficher et le recréer.
C'est du boulot sous VB. Voici comment faire grâce à l'objet FileSystemObject :
Code:
Function numeroter_fichier(fichier As String, numero As Integer) As String
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    numeroter_fichier = FSO.GetParentFolderName(fichier) & "\" & _
                        FSO.GetBaseName(fichier) & "_" & numero & "." & _
                        FSO.GetExtensionName(fichier)
End Function

Code:
Public Sub CommandButton1_Click() 'copie sauvegarde classeur
	Dim nom As String
	Dim wk  As Workbook
	Dim num As Integer

	Set wk = ActiveWorkbook

  num = 1
	nom = numeroter_fichier(wb.Path & "\" & wk.Name, num)
	wb.SaveCopyAs nom

	rep = MsgBox("Votre base de données est sauvegardée sous le nom : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur" )
End Sub

Allez, hop, 4000 fois !
Code:
Public Sub CommandButton1_Click() 'copie sauvegarde classeur
	Dim nom As String
	Dim wk  As Workbook
	Dim num As Integer

	Set wk = ActiveWorkbook

  For num = 1 To 4000
    nom = numeroter_fichier(wb.Path & "\" & wk.Name, num)
    wb.SaveCopyAs nom
    MsgBox "Vos données seraient mieux dans un vrai SGBD ! " & vbCrLf & _
           "En attendant, les voilà sauvées dans : " & nom, _
           vbInformation, _
           "Copie sauvegarde classeur"
  Next           
End Sub

Tu vas en avoir marre de cliquer avant les 4000 ;) ([Ctrl+Pause] pour arrêter le massacre.)

Code:
Public Sub CommandButton1_Click() 'copie sauvegarde classeur
	Dim wk  As Workbook
	Dim num As Integer

	Set wk = ActiveWorkbook

  For num = 1 To 4000
    wb.SaveCopyAs numeroter_fichier(wb.Path & "\" & wk.Name, num)
  Next           
End Sub
 

zeb

Modérateur
Code:
Sub Remplissage()
'
' Remplissage Macro
'
'
Range("C8" ).Select
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C5"
Range("F8" ).Select
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C4"
Range("J8" ).Select
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C9"
Range("C13" ).Select
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C1"
Range("G13" ).Select
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C2"
Range("J13" ).Select
ActiveCell.FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C3"
Range("J14" ).Select
End Sub

Beurk :vomi:
Quelle horreur !!!!

Alors d'abord, on vire les Select/Active !

Code:
Sub Remplissage()
' Remplissage Macro
Range("C8" ).FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C5"
Range("F8" ).FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C4"
Range("J8" ).FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C9"
Range("C13").FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C1"
Range("G13").FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C2"
Range("J13").FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C3"
End Sub

Ensuite on explicite la source et la cible.
A-t-on besoin que les cellules contiennent une formule ou une valeur ?
La réponse à cette question doit venir de toi.

■ Si oui :
Code:
Sub Remplissage()
' Remplissage Macro
   Dim target As Worksheet

   Set target = ActiveWorksheet

   target.Range("C8" ).FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C5"
   target.Range("F8" ).FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C4"
   target.Range("J8" ).FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C9"
   target.Range("C13").FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C1"
   target.Range("G13").FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C2"
   target.Range("J13").FormulaR1C1 = "=[L1RACK_FC_EA.xls]L1RACK_FC_EA!R2C3"
End Sub

■ Si non (et mon petit doigt me dit que c'est ici la bonne solution) :
Code:
Sub Remplissage()
' Remplissage Macro

   Dim source As Worksheet
   Dim target As Worksheet
   
   Set source = Workbooks("L1RACK_FC_EA.xls").Worksheets("L1RACK_FC_EA")
   Set target = ActiveWorksheet

   target.Range("C8" ).Value = source.Range("E2").Value
   target.Range("F8" ).Value = source.Range("D2").Value
   target.Range("J8" ).Value = source.Range("I2").Value
   target.Range("C13").Value = source.Range("A2").Value
   target.Range("G13").Value = source.Range("B2").Value
   target.Range("J13").Value = source.Range("D2").Value   
End Sub
 

picpic62

Nouveau membre
Les cellules sont des chaines de caractères.
Je te remercie pour ces éclaircissements. Je vais essayer ça de suite!! Mais je me demandais s'il n'y avait pas moyen de générer toutes les copies d'un coup sans devoir ousser 4000 fois sur le bouton?
 

zeb

Modérateur
Aller, 4000 fois :
Code:
Public Sub CommandButton1_Click() 'copie sauvegarde classeur
  Dim num As Integer
  Dim nom As String
  Dim a_wb As Workbook
  Dim s_wb As Workbook
  Dim t_wb As Workbook

  Set a_wb = ActiveWorkbook
  Set s_wb = Workbooks("L1RACK_FC_EA.xls" ).Worksheets("L1RACK_FC_EA" )

  For num = 1 To 4000
    nom = numeroter_fichier(a_wb.Path & "\" & a_wb.Name, num)
    a_wb.SaveCopyAs nom

    Set t_wb = Workbooks.Open(nom)

    t_wb.Range("C8" ).Value = s_wb.Range("E2").Value
    t_wb.Range("F8" ).Value = s_wb.Range("D2").Value
    t_wb.Range("J8" ).Value = s_wb.Range("I2").Value
    t_wb.Range("C13").Value = s_wb.Range("A2").Value
    t_wb.Range("G13").Value = s_wb.Range("B2").Value
    t_wb.Range("J13").Value = s_wb.Range("D2").Value
    
    t_wb.Save
    t_wb.Close

  Next
End Sub
 

picpic62

Nouveau membre
Tu vas me dire que je suis completement gauche mais je n'arrive pas a faire fonctionner le code. Et je comprend pas le début ou tu parle de chemin (vu que logiquement il copie dans le même dossier que celui de la source).

J'ai copier coller ton code ds VB et lorsque je click, il m'indique qu'il manque un objet :S...
 

zeb

Modérateur
Rhooooooo, c'est beau.
Et on fait une zolie procédure sans activetruc parce que je n'aime pas ça !

Code:
Public Sub ZolieProc(wb_1 As Workbook)
  Dim num As Integer
  Dim nom As String  
  Dim s_wb As Workbook
  Dim t_wb As Workbook
  
  Set s_wb = Workbooks("L1RACK_FC_EA.xls" ).Worksheets("L1RACK_FC_EA" )

  For num = 1 To 4000
    nom = numeroter_fichier(wb_1.Path & "\" & wb_1.Name, num)
    wb_1.SaveCopyAs nom

    Set t_wb = Workbooks.Open(nom)

    t_wb.Range("C8" ).Value = s_wb.Range("E2").Value
    t_wb.Range("F8" ).Value = s_wb.Range("D2").Value
    t_wb.Range("J8" ).Value = s_wb.Range("I2").Value
    t_wb.Range("C13").Value = s_wb.Range("A2").Value
    t_wb.Range("G13").Value = s_wb.Range("B2").Value
    t_wb.Range("J13").Value = s_wb.Range("D2").Value
    
    t_wb.Save
    t_wb.Close
  Next
End Sub  
  
Public Sub CommandButton1_Click() 'copie sauvegarde classeur
	ZolieProc ActiveWorkbook
End Sub

L'est pas belle la vie ?
 

zeb

Modérateur
Quoi !
Il manque un objet ?

Mon ptit bonhomme, t'auras rien ici si tu ne fais pas d'effort. :o

En l'occurrence, il s'agit de dire où, à quelle ligne, dans quel cas, avec un exemple, et avec le message d'erreur complet !
 

picpic62

Nouveau membre
Oui merci a toi et à ton bos!! ;).
Bon alors la j'ai copier coler ds VB ceci:

[cpp]Function numeroter_fichier(fichier As String, numero As Integer) As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

numeroter_fichier = FSO.GetParentFolderName(fichier) & "\" & _
FSO.GetBaseName(fichier) & "_" & numero & "." & _
FSO.GetExtensionName(fichier)
End Function
Public Sub ZolieProc(wb_1 As Workbook)
Dim num As Integer
Dim nom As String
Dim s_wb As Workbook
Dim t_wb As Workbook

Set s_wb = Workbooks("L1RACK_FC_EA.xls").Worksheets("L1RACK_FC_EA")

For num = 1 To 4000
nom = numeroter_fichier(wb_1.Path & "\" & wb_1.Name, num)
wb_1.SaveCopyAs nom

Set t_wb = Workbooks.Open(nom)

t_wb.Range("C8").Value = s_wb.Range("E2").Value
t_wb.Range("F8").Value = s_wb.Range("D2").Value
t_wb.Range("J8").Value = s_wb.Range("I2").Value
t_wb.Range("C13").Value = s_wb.Range("A2").Value
t_wb.Range("G13").Value = s_wb.Range("B2").Value
t_wb.Range("J13").Value = s_wb.Range("D2").Value

t_wb.Save
t_wb.Close
Next
End Sub

Public Sub CommandButton1_Click() 'copie sauvegarde classeur
ZolieProc ActiveWorkbook
End Sub[/cpp]

Et lorsque je vais clicker sur le bouton, j'ai un message qui me dit:
Incompatibilité de type :'(

Que dois-je faire??
 

picpic62

Nouveau membre
Aucune ligne n'est surlignée, c'est juste une boite à message d'erreur qi s'ouvre avec un bonton OK et un Aide... dans l'aide il parle de l'erreur 13
 

zeb

Modérateur
Ah, ok. Ben faut le préciser quand même. ;)
Alors, mets un point d'arrêt sur la ligne 15 (mets le curseur sur la ligne "Set s_wb = " et appuie sur F9) puis clique sur ton bouton.

Ensuite, appuie sur F8 jusqu'à ce que l'erreur se produise. Et là, dis-moi sur quelle ligne il plante.
 

zeb

Modérateur
picpic62, c'est y qu't'es un boyau rouche, ou c'est y qu't'es belche ? (*)
(*) Si tu veux pas le dire, spa un problème
 

picpic62

Nouveau membre
Bon j'ai fai ce que tu m'as di. Dés que j'enfonce F8, le message réaparait et la ligne "Set s_wb..." est en rouge.
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 098
Messages
6 717 043
Membres
1 586 281
Dernier membre
moto45ktm
Partager cette page
Haut