Découpage, procédure trop longue. Transfert Excel vers Word

[GENTILE]

Bonjour,

Après plusieurs jour de codage,

J'arrive à un codage avoisinant les 3800 lignes et donc au lancement je me doutais un peu de la chose, j'ai ce joli message et prévisible qui apparaît "Erreur de compilation : Procédure trop grande".

Je peux vous donner une partie du code, toute les lignes sont identiques, le but et de prendre une valeur dans un Excel et de remplacer le SIGNET Word identifier par la valeur de cette cellule. Sa fonctionne avec 1002 et dés que je passe à 1004 car les commandes fonctionnent par paire, sa ne fonctionne plus.
Mais chaque paire correspond à un signet et à une valeur.

Comment puis-je découper ce code afin qu'il s’exécute entièrement. Je pensais faire un découpage par chapitre par exemple mais sans aide de votre part.

Toutes mes informations à transférer sont regroupée sur une seule et même Feuille de calcul.
certaine ligne de code vont chercher un mot, comme les première (copier coller pure et dure),
d'autres lignes de code vont chercher une valeur calculée et avec un application d'arrondie toute simple.

Sub exportDonneesDansSignetsWord()
'nécéssite d'activer la référence Microsoft Word xx.x Object Library
Dim WordApp As Word.Application
Dim WordDoc As Word.Document

Set WordApp = CreateObject("word.Application") 'ouvre session word
Set WordDoc = WordApp.Documents.Open("C:\Projet v1.0.doc")  'ouvre document Word
WordApp.Visible = True 'word visible pendant l'operation

'les signets du document Word sont nommés X1 à X19
Set monsignet = WordDoc.Bookmarks("X1").Range
monsignet.Text = Sheets("Adminx").Range("I1").Value
Set monsignet = WordDoc.Bookmarks("X2").Range
monsignet.Text = Sheets("Adminx").Range("C1").Value
Set monsignet = WordDoc.Bookmarks("X3").Range
monsignet.Text = Sheets("Adminx").Range("C5").Value
.
.
.
.
Set monsignet = WordDoc.Bookmarks("Y152").Range
monsignet.Text = Round((Sheets("Transfert").Range("P60").Value), 2)
Set monsignet = WordDoc.Bookmarks("Y153").Range
monsignet.Text = Round((Sheets("Transfert").Range("P61").Value), 2)


End Sub

Merci énormément pour votre aide par avance.
Cordialement. GENTILE

 

[GENTILE]

Je pense que la macro excède les 64ko, puis-je la scinder en plusieurs module et faire en sorte que ces modules s’exécutent les uns derrières les autres?

 

[Dranreb]

Bonsoir.

Toutes mes informations à transférer sont regroupée sur une seule et même Feuille de calcul.

Absolument dans n'importe quel désordre, on dirait…
Si la feuille était organisée intelligemment, avec les noms de signets y étant portés, ou s'il y avait une logique permettant de les déduire de ce qu'il y a, peut être que la totalité de la procédure pourrait s'écrire en moins de 10 lignes !

 

[GENTILE]

Bonjour Dranreb et merci pour ta réponse, mais pourrais-tu être plus concret.
Il est vrai que mes premières lignes sont un peu disparate, mais il n'y en a que 10.

C'est plutôt le code qui me permettrait de réduire les quatre dernières lignes, qui serait intéressant pour moi.
Car oui l'on pourrait en déduire une logique.
Une réorganisation de mon excel s'impose. Genre le signet en colonne A la cellule á copier dans le word en colonne B et intituler mes signets 1; 2; 3; ...

Un petit exemple serait la bienvenu, étant loin d'être très doué en VBA Excel.

Merci de ton aide.

Cordialement.

 

[Dranreb]

Bonjour. À essayer :

Const NbLig = 2
Dim T() As Variant, L As Long
T = Sheets("Transfert").Range("P60").Resize(NbLig).Value
For L = 1 To NbLig
   worddoc.Bookmarks("Y" & L + 151).Range.Text = Int(T(L, 1) * 100 + 0.5) / 100
   Next L

 

[GENTILE]

Merci Dranreb, mais étant beaucoup plus compétant que moi, peux-tu me décomposer ta formule avec des indications, explications, ...

Cordialement.

 

[Dranreb]

C'est à essayer, c'est tout.
Qu'est ce que tu veux que je décompose ?
Dis moi toi ce que tu ne comprends pas, je ne peux pas le deviner.

 

[GENTILE]

Et bien c'est toute la fonction, je nage pitoyablement. Se que fait chaque ligne, ...
Se que tu as écrit permet en bref de faire plusieurs transfert Excel vers Word en incrémentant les signets de Word qui seront prédéfini et les cellules, mais j'aurais a imposer le nombre de répétition, ce qui m'évite de retaper systématiquement les mêmes lignes c'est bien cela?

 

[GENTILE]

Et bien plus de détailles, la fonction de chaque ligne, les significations, ... J'aimerais bien comprendre le fonctionnement plutôt que de tester bêtement sans comprendre comment cela fonctionne.

 

[Dranreb]

J'en conclu que ça marche alors ? (je ne connais rien aux méthodes et propriétés des objets représentant les entités Word)
Le nombre de répétition c'est NbLig dans mon exemple.

 

[GENTILE]

Et bien écoute je vois pour intégrer ta formule, l'adapter mais pas fastoche, merci pour ton aide. Je re-posterais ici quand j'aurais trouver une solution.

 

[Dranreb]

Bonjour.
Remarque.
Si vous joigniez votre classeur, je pourrais peut être vous indiquer une procédure qui en exploiterait plus judicieusement les informations qu'il contient.

 

[GENTILE]

Je vois pour vous faire, un truc qui s'en rapproche, car l'original est très lourd. Du coup quand j'y repense, une seule variable sera nécessaire du fait que les paramètres évolueront en parallèle certes deux colonnes mais qui seront fixes seul la ligne et le numéro de signet évolueront ensemble de la même manière.

 

[GENTILE]

Voici le fichier avec lesquels tu peux tester ta formule, c'est une version très simplifié mais le principe est le même.
En espérant que la répétition d'une commande qui incrémente le numéro de signet et le numéro de ligne de la colonne B soit plus fructueux, plutôt que la répétition d'un copié-collé en changeant le nom de signet et la cellule avec le contenu à modifier.
En espérant passer de 3754 lignes pour 1877 informations à transférer, à quelques lignes pour transférer l'équivalent d'information.

Perso je galère un peu étant noob en VBA.

Encore merci pour ton aide.

 

[Dranreb]

A essayer :

Sub ExportDonneesDansSignetsWord()
Dim T() As Variant, L As Long
Dim WordApp As Word.Application
'Nécessite d'activer la référence Microsoft Word xx.x Object Library
'(Dim WordApp As Object ne le nécessiterait pas mais c'est moins bon à mon sens)
Dim WordDoc As Word.Document
'Nécessite d'activer la référence Microsoft Word xx.x Object Library
'(Dim WordDoc As Object ne le nécessiterait pas mais c'est moins bon à mon sens)

T = ActiveSheet.[A2].Resize(ActiveSheet.[A1000000].End(xlUp).Row - 1, 2).Value

Set WordApp = New Word.Application 'ouvre session word'
'Nécessite d'activer la référence Microsoft Word xx.x Object Library
'(= CreateObject("word.Application") ne le nécessiterait pas mais c'est moins bon à mon sens)

Set WordDoc = WordApp.Documents.Open("C:\Users\Word Transfert.doc")  'ouvre document Word
WordApp.Visible = True 'word visible pendant l'operation

For L = 1 To UBound(T, 1)
   WordDoc.Bookmarks(T(L, 1)).Range.Text = T(L, 2)
   Next L
End Sub