[VBA] erreur de compilation procédure trop grande

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : [VBA] erreur de compilation procédure trop grande

foxley_gravity

Bonjour ,
toujours débutant en VBA j'ai une macro qui fait 365ko ..et ce message d'erreur m'apparait ...erreur de compilation procédure trop grande

En faite la quasi totalité du code est dans un Private Sub CommandButton_Click() ... mais le hic c'est que je pas trop la découpé en de petit bouton , car l'utilisateur devra appuyer que sur une bouton ( j'ai deja fait beucoup de boucle pour limité la longueur ..)

merci de donner idée et des solutions
ps : j'ai deux autres posts toujours en attente de réponses
cordialement

Message cité 1 fois

Publicité

drasche

La réponse est dans la question: découple en plusieurs fonctions. Chacune de tes fonctions devrait être courte. Très courte, genre 20-30 lignes.

Evite aussi de déclarer 47.000 variables en dehors de tes fonctions, c'est une mauvaise habitude. Déclare autant que possible à l'intérieur des fonctions.

Et tape un Option Explicit en première ligne de ton module. Si ça ne marche plus, c'est que c'est encore pire que tu le croyais.

---------------
Whichever format the fan may want to listen is fine with us – vinyl, wax cylinders, shellac, 8-track, iPod, cloud storage, cranial implants – just as long as it’s loud and rockin' (Billy Gibbons, ZZ Top)

Moktar1er

No one replies...

On peut avoir un copié/collé du code ?

drasche

foxley_gravity a écrit :

( j'ai deja fait beucoup de boucle pour limité la longueur ..)

En fait ce passage me fait encore plus peur. Mais c'est bien que tu ais vu l'usage qu'on peut faire des boucles.

foxley_gravity

lol le code fait plus de 3 milles caractères je crois ^^ il y a beaucoup de copier collé .. mais obligatoire , car aucune logique dans la copie de cellule ( des dizaine d'onglet avec chacun des centaines de cellules)

donc reprenons ,j'ai un bouton ... c'est possible de mettre plusieurs petite procédure dans un bouton ?
si oui faudra t'il faire des changements du genre répéter les variables ?

cordialement

ps : ca serait vraiment génial si qql pouvait m'aider sur les posts : Problème dans une macro devant faire un tri,
[VBA] problème dans une boucle

Deamon

Comme a dit drasche il faut découper en plusieurs sous fonctions que tu apellera avec des CALL dans ton event Click.

Moktar1er

No one replies...

Et sans mettre le code ici, on aura du mal à te dire où couper, où faire les fonctions et comment etc.

foxley_gravity

question sudsidiere :comment copier un commentaire d'une cellule d'un workbook dans une autre cellule d'un autre workbook ?

J'ai essayé ca mais ca marche pas :

Cells(2, 2).ClearComments
Cells(2, 2).Select
Cells(2, 2).AddComment
Workbooks(1).Worksheets(1).Cells(3, 3).Comment.Text Text:=Workbooks(2).Worksheets(1).Cells(2, 2).Comment

exemple du code à compacter :

Code :

'Début de l'écriture du ficher log (qui s'enregistre dans mes documents)
 
 
Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
 
Dim fs, f, ts, s
 
Set fs = CreateObject("Scripting.FileSystemObject" )
 fs.CreateTextFile "fichier_log.txt"      'Crée un fichier
  Set f = fs.GetFile("fichier_log.txt" )
  Set ts = f.OpenAsTextStream(ForWriting, TristateUseDefault)
     
  On Error Resume Next
 
 
'--------------------------------------------------------------------------------------------------------------------
' Ouverture des fichiers nécéssaires à l'inventaire
 
'Fichier cible
'--------------------------------------------------------------------------------------------------------------------
' ouverture fichier indiv
 
Workbooks.Open Filename:="F:\013_DirFinTech\042_DptEtudes\018_SrvSupFiabSI\SOP - Support Offres Produits\Inventaire emprunteurs\Laurent\fichier nécessaire2\indiv08.xls"
 
 If Err.Number = 0 Then ' Pas d'erreur lors de l'ouverture du fichier
     ts.Write "ouverture du fichier indiv ok" & vbCrLf
     Else
     ts.Write "ouverture du fichier indiv échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
     
'Fichier Source
'--------------------------------------------------------------------------------------------------------------------
' ouverture fichier envoyé par la gestion des contrats
 
Workbooks.Open Filename:="F:\013_DirFinTech\042_DptEtudes\018_SrvSupFiabSI\SOP - Support Offres Produits\Inventaire emprunteurs\Laurent\fichier nécessaire2\STATISTIQUES MENSUELLESmai1.xls"
 
 If Err.Number = 0 Then ' Pas d'erreur lors de l'ouverture du fichier
     ts.Write "ouverture du fichier gestion des contrats ok" & vbCrLf
     Else
     ts.Write "ouverture du fichier gestion des contrats échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
     
' ouverture fichier envoyé par la sélection médicale
 
Workbooks.Open Filename:="F:\013_DirFinTech\042_DptEtudes\018_SrvSupFiabSI\SOP - Support Offres Produits\Inventaire emprunteurs\Laurent\fichier nécessaire2\2008Sinistres02062009.xls"
 
 If Err.Number = 0 Then ' Pas d'erreur lors de l'ouverture du fichier
     ts.Write "ouverture du fichier sélection médicale ok" & vbCrLf
     Else
     ts.Write "ouverture du fichier sélection médicale échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
       
' ouverture fichier envoyé par la comptabilité
 
Workbooks.Open Filename:="F:\013_DirFinTech\042_DptEtudes\018_SrvSupFiabSI\SOP - Support Offres Produits\Inventaire emprunteurs\Laurent\fichier nécessaire2\balance prev.300609.xls"
  
 If Err.Number = 0 Then ' Pas d'erreur lors de l'ouverture du fichier
     ts.Write "ouverture du fichier comptabilité ok" & vbCrLf
     Else
     ts.Write "ouverture du fichier comptabilité échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur

foxley_gravity

Code :

'--------------------------------------------------------------------------------------------------------------------
'Information sur le nombre d'assuré
 
 
'pour PREVI AVENIR
 Workbooks("indiv08.xls" ).Worksheets("PREVI" ).Cells(103, 3).Value = Workbooks("STATISTIQUES MENSUELLESmai1.xls" ).Worksheets("06 2009" ).Cells(8, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(103, 3)nombre d'assuré,PREVI AVENIR  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(103, 3)nombre d'assuré,PREVI AVENIR échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'pour PREVI MUTUEL
 Workbooks("indiv08.xls" ).Worksheets("PREVI" ).Cells(105, 3).Value = Workbooks("STATISTIQUES MENSUELLESmai1.xls" ).Worksheets("06 2009" ).Cells(9, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(105, 3)nombre d'assuré,PREVI MUTUEL  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(105, 3)nombre d'assuré,PREVI MUTUEL échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'pour ATLANTIQUE AVENIR
 Workbooks("indiv08.xls" ).Worksheets("PREVI" ).Cells(104, 3).Value = Workbooks("STATISTIQUES MENSUELLESmai1.xls" ).Worksheets("06 2009" ).Cells(10, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(104, 3)nombre d'assuré,ATLANTIQUE AVENIR  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(104, 3)nombre d'assuré,ATLANTIQUE AVENIR échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'Information concernant les capitaux sous risque
 
'pour PREVI AVENIR
Workbooks("indiv08.xls" ).Worksheets("PREVI" ).Cells(107, 3).Value = Workbooks("STATISTIQUES MENSUELLESmai1.xls" ).Worksheets("06 2009" ).Cells(8, 3).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(107, 3)nombre d'assuré,PREVI AVENIR  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(107, 3)nombre d'assuré,PREVI AVENIR échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'pour PREVI MUTUEL
Workbooks("indiv08.xls" ).Worksheets("PREVI" ).Cells(109, 3).Value = Workbooks("STATISTIQUES MENSUELLESmai1.xls" ).Worksheets("06 2009" ).Cells(9, 3).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(109, 3)nombre d'assuré,PREVI MUTUEL  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(109, 3)nombre d'assuré,PREVI MUTUEL échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'pour ATLANTIQUE AVENIR
Workbooks("indiv08.xls" ).Worksheets("PREVI" ).Cells(108, 3).Value = Workbooks("STATISTIQUES MENSUELLESmai1.xls" ).Worksheets("06 2009" ).Cells(10, 3).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(108, 3)nombre d'assuré,ATLANTIQUE AVENIR  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(108, 3)nombre d'assuré,ATLANTIQUE AVENIR échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
'--------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------
'Information envoyé par les partenaires
 
 
'--------------------------------------------------------------------------------------------------------------------
'Information envoyé par le produit PAA
 
'pour le partenaire CMB
 
'concernant les cotisations
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(14, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(16, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(14, 3)produit PAA,CMB,cotis  ok" & vbCrLf
     Else
     ts.Write "copie de cellule 14, 3)produit PAA,CMB,cotis échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les frais de gestion Pol Pay
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(36, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(7, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(36, 3)produit PAA,CMB,frais de gestion pol pay ok" & vbCrLf
     Else
     ts.Write "copie de cellule(36, 3)produit PAA,CMB,frais de gestion pol pay  échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les frais de gestion Pol Grat
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(37, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(8, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(37, 3)produit PAA,CMB,frais de gestion pol grat   ok" & vbCrLf
     Else
     ts.Write "copie de cellule(37, 3)produit PAA,CMB,frais de gestion pol grat  échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant les frais de gestion affranchissement
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(38, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(9, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(38, 3)produit PAA,CMB,gestion affranchissement  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(38, 3)produit PAA,CMB,gestion affranchissement  échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant les autres frais de gestion
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(39, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(10, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(39, 3)produit PAA,CMB,autres frais de gestion ok" & vbCrLf
     Else
     ts.Write "copie de cellule(39, 3)produit PAA,CMB,autres frais de gestion échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant le nombre d'assuré grat
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(97, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(11, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(97, 3)produit PAA,CMB,nombre d'assuré grat ok" & vbCrLf
     Else
     ts.Write "copie de cellule(97, 3)produit PAA,CMB,nombre d'assuré grat échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant le nombre d'assuré pay
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(98, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(12, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(98, 3)produit PAA,CMB,nombre d'assuré pay ok" & vbCrLf
     Else
     ts.Write "copie de cellule(98, 3)produit PAA,CMB,nombre d'assuré pay échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant les capitaux sous risque
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(103, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(13, 2).Value
 
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(103, 3)produit PAA,CMB,capitaux sous risque ok" & vbCrLf
     Else
     ts.Write "copie de cellule(103, 3)produit PAA,CMB,capitaux sous risque échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant les sinitres
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(80, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(14, 2).Value
 
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(80, 3)produit PAA,CMB,concernant les sinitres ok" & vbCrLf
     Else
     ts.Write "copie de cellule(80, 3)produit PAA,CMB,concernant les sinitres échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant le nom des sinistrés en commentaire
'Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(80, 3).Value = Workbooks("reponsePAA1.xls" ).Worksheets("CMB" ).Cells(15, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(80, 3)  ok" & vbCrLf
     Else
     ts.Write "copie de cellule (80, 3) échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'--------------------------------------------------------------------------------------------------------------------
'pour le partenaire CMLACO
 
'concernant les cotisations
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(15, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(16, 2).Value
 
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(15, 3)produit PAA,CMLACO,cotis ok" & vbCrLf
     Else
     ts.Write "copie de cellule(15, 3)produit PAA,CMLACO,cotis  échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant les frais de gestion Pol Pay
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(42, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(7, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(42, 3)produit PAA,CMLACO,frais de gestion Pol Pay  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(42, 3)produit PAA,CMLACO,frais de gestion Pol Pay échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les frais de gestion Pol Grat
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(43, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(8, 2).Value
 
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(43, 3)produit PAA,CMLACO,frais de gestion Pol Grat  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(43, 3)produit PAA,CMLACO,frais de gestion Pol Grat échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les frais de gestion affranchissement
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(44, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(9, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(44, 3)produit PAA,CMLACO,frais de gestion affranchissement  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(44, 3)produit PAA,CMLACO,frais de gestion affranchissement échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les autres frais de gestion
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(45, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(10, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(45, 3)produit PAA,CMLACO,autres frais de gestion  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(45, 3)produit PAA,CMLACO,autres frais de gestion échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant le nombre d'assuré grat
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(99, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(11, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(99, 3)produit PAA,CMLACO,nombre d'assuré grat  ok" & vbCrLf
     Else
     ts.Write "copie de cellule (99, 3)produit PAA,CMLACO,nombre d'assuré grat échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant le nombre d'assuré pay
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(100, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(12, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(100, 3)produit PAA,CMLACO,nombre d'assuré pay  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(100, 3)produit PAA,CMLACO,nombre d'assuré pay échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les capitaux sous risque
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(104, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(13, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(104, 3)produit PAA,CMLACO,capitaux sous risque  ok" & vbCrLf
     Else
     ts.Write "copie de cellule(104, 3)produit PAA,CMLACO,capitaux sous risque échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les sinitres
Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(90, 3).Value = Workbooks("reponsePAA2.xls" ).Worksheets("CMLACO" ).Cells(14, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(90, 3)produit PAA,CMLACO,concernant les sinitres ok" & vbCrLf
     Else
     ts.Write "copie de cellule(90, 3)produit PAA,CMLACO,concernant les sinitres  échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant le nom des sinistrés en commentaire
'Workbooks("indiv08.xls" ).Worksheets("PAA" ).Cells(90, 3).Value = Workbooks("reponsePAA.xls" ).Worksheets("CMLACO" ).Cells(15, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(90, 3)produit PAA,CMLACO,concernant les sinitres ok" & vbCrLf
     Else
     ts.Write "copie de cellule(90, 3)produit PAA,CMLACO,concernant les sinitres échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'--------------------------------------------------------------------------------------------------------------------
'Information envoyé par le produit PPA
 
 
'--------------------------------------------------------------------------------------------------------------------
'pour le partenaire GFP
 
'concernant les cotisations
Workbooks("indiv08.xls" ).Worksheets("PPA" ).Cells(14, 3).Value = Workbooks("reponsePPA1.xls" ).Worksheets("CMLACO" ).Cells(11, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(14, 3)  ok" & vbCrLf
     Else
     ts.Write "copie de cellule (14, 3) échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les frais de gestion Pol Pay
Workbooks("indiv08.xls" ).Worksheets("PPA" ).Cells(36, 3).Value = Workbooks("reponsePPA1.xls" ).Worksheets("CMLACO" ).Cells(7, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(36, 3)  ok" & vbCrLf
     Else
     ts.Write "copie de cellule (36, 3) échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
 
'concernant les frais de gestion Pol Grat
Workbooks("indiv08.xls" ).Worksheets("PPA" ).Cells(37, 3).Value = Workbooks("reponsePPA1.xls" ).Worksheets("CMLACO" ).Cells(8, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(37, 3)  ok" & vbCrLf
     Else
     ts.Write "copie de cellule (37, 3) échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant le nombre d'assuré grat
Workbooks("indiv08.xls" ).Worksheets("PPA" ).Cells(97, 3).Value = 0
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(97, 3)  ok" & vbCrLf
     Else
     ts.Write "copie de cellule (97, 3) échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant le nombre d'assuré pay
Workbooks("indiv08.xls" ).Worksheets("PPA" ).Cells(98, 3).Value = 1022
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(98, 3)  ok" & vbCrLf
     Else
     ts.Write "copie de cellule (98, 3) échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur
 
'concernant les sinistre
Workbooks("indiv08.xls" ).Worksheets("PPA" ).Cells(80, 3).Value = Workbooks("reponsePPA1.xls" ).Worksheets("CMLACO" ).Cells(9, 2).Value
 
If Err.Number = 0 Then ' Pas d'erreur lors de la copie
     ts.Write "copie de cellule(80, 3)  ok" & vbCrLf
     Else
     ts.Write "copie de cellule (80, 3) échec" & vbCrLf
      End If
     Err.Clear 'remettre à 0 la valeur de l'erreur

drasche

hint: tu peux passer des paramètres à tes fonctions.

hint2: ta fonction peut renvoyer une valeur de résultat.

Publicité

foxley_gravity

excuse moi drasche mais je vois pas trop , peut tu me donner un exemple à partir de mon code ? merci

seniorpapou

Bonjour,
Faire un
sub openwkb(nomfichier as string, compl_message as string)
Workbooks.Open Filename:="F:\013_DirFinTech\042_DptEtudes\018_SrvSupFiabSI\SOP - Support Offres Produits\Inventaire emprunteurs\Laurent\fichier nécessaire2\" & nomfichier
If Err.Number = 0 Then ' Pas d'erreur lors de l'ouverture du fichier
ts.Write "ouverture du fichier " & compl_message & "ok" & vbCrLf
Else
ts.Write "ouverture du fichier" & compl_message & "échec" & vbCrLf
End If
Err.Clear 'remettre à 0 la valeur de l'erreur

Message édité par seniorpapou le 13-08-2009 à 10:12:59

seniorpapou

Re,
en regardant tes "copiés" il semble que tes liens entre PPA (récepteur) et
et CMLACO, CMB etc... soient fixes.
dans ce cas, au niveau de PPA, utilise , pour une cellule donnée la fonction = ....... en allant chercher la valeur dans le workbook désiré. Tu n'as pas besoin de VB pour faire cela.
Il semble que tu sois hyper-actif, hyper-courageux, mais essaye de réfléchir avant de toucher ton clavier!!!
Bonne journée.

foxley_gravity

ok merci papou , dit moi si c'est le bon truc alors
Si c'est bon dis moi comment integrer le tout dans un bouton merci bcp

Code :

Sub toto()
 
Call lolo("indiv08.xls" )
Call lolo("tous les autre fichier" )
'.....
end sub
 
Function lolo(nomfichier As String)
 
 
Workbooks.Open Filename:="F:\013_DirFinTech\042_DptEtudes\018_SrvSupFiabSI\SOP - Support Offres Produits\Inventaire emprunteurs\Laurent\fichier nécessaire2\" & nomfichier  
 
end function

foxley_gravity

et j'ai pas trop compris ta derniere remarque lol , si tu pouvez me faire encore un si beau exemple lol ... oui avec environ 5000 lignes comme ca ( change apres pas tjrs des copies lol ) ,je pense être le roi des courageux aux pays des imbécile

seniorpapou

re,
tu n'es pas loin, mais remplace "function" par SUB, je crois que quelqu'un t'as déjà dit la différence entre function et sub.
si tu fais la mise à jour par le =...... dont je t'ai parlé, tu n'auras probablement pas besoin de faire tes open.....

pour intégrer le lancement de la "macro toto() dans ton bouton, au moment de la création de ton bouton, tu indiques le nom de la macro à lancer: ici ce sera toto

Message édité par seniorpapou le 13-08-2009 à 10:40:40

foxley_gravity

ok merci
mais pour lancer toto il faut mettre quoi comme instruction dans le

Private Sub CommandButton20_Click()

start sub toto() ?

et j'ai toujours pas trop compris l'histoire de la mise à jour avec le =

Message cité 1 fois

seniorpapou

Re,
as-tu acheté des bouquins du style: ACCESS pour les nuls, et EXCEL pour les nuls, il n'y a pas grand chose dedans mais cela pourrait te servir pour connaître un certain nombre de possibilités, et, connaissant ces possibilités, tu pourrais réorganiser ton travail. Tu gagneras beaucoup de temps, en consacrant du temps à la réflexion Il y a peut-être d'autres bouquins, mais je ne connais pas trop......

Deamon

call toto

C'est pas comme si t'avais jamais vu cette instruction en plus...

foxley_gravity

ok mais , je savais pas que l'on pouvez pas appelé des sub , aussi je croyais que c'était jsute des variables du type non du fichier ....

seniorpapou

foxley_gravity a écrit :

ok merci
mais pour lancer toto il faut mettre quoi comme instruction dans le

Private Sub CommandButton20_Click()

call toto
et j'ai toujours pas trop compris l'histoire de la mise à jour avec le =

désolé Deamon, je n'avais pas vu ta réponse.

Message édité par seniorpapou le 13-08-2009 à 10:55:55

Deamon

Mais des sub c'est comme des function mais ça renvoit rien c'est tout. Ce sont des fonctions les 2 que tu peux appeler.

seniorpapou

foxley......, si j'ai le temps, je te prendrai en MP pour l'utilisation du signe =, dans l'après midi. C'est un peu le B A BA d'Excel et je crois qu'il n'est pas nécessaire de saturer les post's pour cela.

drasche

(il lui faudrait un tuto sur la prog, surtout)

Message cité 1 fois

Deamon

drasche a écrit :

(il lui faudrait un tuto sur la prog, surtout)

C'est pas faute de lui avoir dit... Car vu tous les problèmes qu'il a il gagnerait du temps à lire un bouquin.

foxley_gravity

ok merci bcp papou , ca serait avec plaisir dis moi a quel heure ..

Message cité 1 fois

seniorpapou

Et sur excel aussi, si j'ai bien compris.

seniorpapou

foxley_gravity a écrit :

ok merci bcp papou , ca serait avec plaisir dis moi a quel heure ..

aucune idée, mais je t'enverrai un Message dès que je suis disponible

Message édité par seniorpapou le 13-08-2009 à 11:09:19

foxley_gravity

ben vba pour excel ,et vba en général , mais sinon excel tout seul c'est bon ..

foxley_gravity

ok merci les call marche nickel seul probleme , au niveau du fichier log , il y a uniquement le commentaire du dernier call , qui apparait alors que moi je les voudrais tous , ie qu'il ne s'éfface pas au profit du dernier ...
en vous remerciant

seniorpapou

ForAppending au lieu de for writing

Publicité

FORUM HardWare.fr

Programmation

VB/VBA/VBS

[VBA] erreur de compilation procédure trop grande

Sujets relatifs
Debutant VB: un probleme de ligne a copier!!!	[VBA] Pb valeur dans une cellule
[VBA] Problème avec Workbooks.Open	[VBA] problème dans une boucle
[VBA] Charger une DLL vbcrypt.dll	Procédure à suivre pour les requêtes
[VBA]ouvrir un page internet et inscrire un code pour ouvrir undossier	VBA Graphiques
Erreur sur site qui décale le menu	[VBA] ouvrir un fichier dont le repertoire est choisi par lutilisateur
Plus de sujets relatifs à : [VBA] erreur de compilation procédure trop grande

Page générée en 0.186 secondes