besoin d'aide pour un code vba dans une macro

zephir94 à dit:

Bonjour, j'ai réussi a élucider certains points de mes questions du poste suivant mais j'en ai une importante a te poser, la première feuille a l'origine était en format word y a t il un moyen de pouvoir partire de cette feuille et de faire la même chose ? Merci du temps que tu prends pour moi Cordiales salutation

Cliquez pour agrandir...

zephir94 à dit:

Bonjour a toi ,
J'ai trouvé ce code permettant de pouvoir récuperer des donnée dans word et les copiers vers excel

Copier une ligne precise d'un tableau word et le coller dans Excel
Sub importValeurs_De_tablesWord()
'Activer la reference Microsoft Word xx.x Object Library
Dim wordApp As Word.Application
Dim wordDoc As Word.Document
Set wordApp = createObject("word.application")
wordApp.Visible = False 'Word reste masqué pendant l'opéraion
Set wordDoc = wordApp.Documents.Open("C:\monDocument.doc") 'ouvre le document Word
'copies la 3eme ligne de la 1ere table Word
wordDoc.Tables(1).Rows(3).Range.Copy
'collage dans Excel
Range("A1").pasteSpecial xlPasteValues
wordDoc.Close 'fermeture document Word
wordApp.Quit 'fermeture session Word
End Sub


pourais tu m'aider a l'adapter a mon besoin c'est a dire l'inserer dans ta prog affin de faire la meme chose mais en partant de word pour le fichier bordereau d'envoi mais concerver dans excel la copie dans les champs vide et créer une page en fin de page
le code que j'ai trouvé je ne sais pas si je dois l'incerer dans word ou dans excel. Peux tu m'aider
merci par avance
Cordiales salutations

Cliquez pour agrandir...

zephir94 à dit:

Hello je t'ai envoyé un message en privé , pour le boutton je pensais enfait le mettre seule a la place de la première page dans le dossier excel si tenté que ce soit de excel que l on puisse exécuter la macro dans word j'ai repéré en bas dans la barre les coordonnées de chaque ligne et colones

mon mail est zephir94@orange.fr

Cliquez pour agrandir...

' ------------------------ LECTURE DU FICHIER  zephir94.doc -----------------------------
' zephir94.doc doit être situé dans le même répertoire que zephir94.xls
Set wordApp = CreateObject("word.application")
wordApp.Visible = False 'Word reste masqué pendant l'opéraion
Set wordDoc = wordApp.Documents.Open(ThisWorkbook.Path & "[COLOR="RoyalBlue"][B]\zephir94.doc[/B][/COLOR]") 'ouvre le document Word
' copie les valeurs de tableau de zephir94.doc dans la feuille Bordereau d'envoi de zephir94.xls
Feuil1.Range("C11").Value = wordDoc.Tables(2).Cell(1, 2)

zephir94 à dit:

Bonsoir

je viens d'essayer ton fichier et j'ai trouvé que si tu envois 4 fois de suite les données la macro plante sur le mot de passe, pour les caractères spéciaux j'ai trouvé sur le net

Quand on exporte du texte dans excel ou word (fichiers .csv renommés en .xls, fichiers .txt renommés en .doc ...), les caractères spéciaux sont remplacés par d'autres caractères et rendent le texte illisible.
Le charset n'est malheureusement pas modifiable 🙁
Cette fonction permet donc de rétablir la plupart des caractères spéciaux connus.


1.$replace = array(
2. "Å " => "Š", "Å¡" => "š", "Å'" => "Œ", "Å"" => "œ",
3. "Ÿ" => "Ÿ", "ÿ" => "ÿ", "À" => "À", "à " => "à",
4. "Ã" => "Á", "á" => "á", "Â" => "Â", "â" => "â",
5. "Ã" => "Ã", "ã" => "ã", "Ä" => "Ä", "ä" => "ä",
6. "Ã…" => "Å", "Ã¥" => "å", "Æ" => "Æ", "æ" => "æ",
7. "Ç" => "Ç", "ç" => "ç", "È" => "È", "è" => "è",
8. "É" => "É", "é" => "é", "Ê" => "Ê", "ê" => "ê",
9. "Ë" => "Ë", "ë" => "ë", "ÃŒ" => "Ì", "ì" => "ì",
10. "Ã" => "Í", "Ã*" => "í", "ÃŽ" => "Î", "î" => "î",
11. "Ã" => "Ï", "ï" => "ï", "Ã" => "Ð", "ð" => "ð",
12. "Ã'" => "Ñ", "ñ" => "ñ", "Ã'" => "Ò", "ò" => "ò",
13. "Ã"" => "Ó", "ó" => "ó", "Ã"" => "Ô", "ô" => "ô",
14. "Õ" => "Õ", "õ" => "õ", "Ö" => "Ö", "Ø" => "Ø",
15. "ø" => "ø", "Ù" => "Ù", "ù" => "ù", "Ú" => "Ú",
16. "ú" => "ú", "Û" => "Û", "û" => "û", "Ãœ" => "Ü",
17. "ü" => "ü", "Ã" => "Ý", "ý" => "ý", "Þ" => "Þ",
18. "þ" => "þ", "ß" => "ß", "ö" => "ö"
19.);
20.function changeAccented($text) {
21. global $replace;
22. foreach($replace as $key => $val)
23. $text = str_replace($key, $val, $text);
24. return $text;
25.}

Cliquez pour agrandir...

' ------------------------ TRANSFERT DES DONNEES DE LA FEUILLE Bordereau d'envoi DANS LA FEUILLE Page X -----------------------------
' On teste la position de la dernière ligne remplie sur la dernière feuille du classeur
' La ligne suivante part de la dernière cellule en bas de la colonne A et remonte sur la dernière ligne remplie, puis teste sa position :
  ' Si cette ligne est la n°82, alors on appelle la macro de création de feuille nommée "CopieFeuille"
If Sheets(Sheets.Count).Range("A65536").End(xlUp).Row = [COLOR="Red"][B]82 [/B][/COLOR]Then CopieFeuille ' On peut traduire cette ligne ainsi :
  ' Dans la dernière feuille du tableau (Sheets.Count) --> compte le nbre de feuilles), et en partant de la dernière cellule en colonne A _
  (Range("A65536") on remonte jusqu'à la dernière ligne contenat des données (End(xlUp) et on note son n° de ligne (Row)

' Toutes les lignes suivantes opèreront dans la dernière feuille du tableau (With sheets... --> Avec la feuille en dernière position)
With Sheets(Sheets.Count)
  .Unprotect "zephir"
' On affecte le n° de la dernière ligne remplie à la variable dLg et on lui ajoute 1 pour passer à la ligne vide juste en dessous
  dLg = .Range("A65536").End(xlUp).Row + 1
  ' Les cellules A4 et A5 étant fusionnées, dLg est initialisé à 4 +1 = 5 sur la feuille vierge, il faut donc lui ajouter 1 pour passer à la 6ème ligne
  If dLg = 5 Then dLg = 6
  ' On affecte à chaque cellule de la dernière feuille la valeur de la cellule adéquate de la feuille "Bordereau d'envoi"
  ' Cells(dLg, 1) peut se traduire par : cellule située sur la ligne dLg et la colonne 1, donc colonne A
  ' Feuil1.Range("C11") peut se traduire par : cellule C11
  ' On pourrait tout auusi bien écrire : .Range("A" & dLg) = Feuil1.Range("C11")
  .Cells(dLg, 1) = Feuil1.Range("C11")
  .Cells(dLg, 2) = Feuil1.Range("H20")
  .Cells(dLg, 3) = Feuil1.Range("I15")
  .Cells(dLg, 4) = Feuil1.Range("B58")
  .Cells(dLg, 8) = Feuil1.Range("J20")
  .Protect "zephir"
' On termine les interventions sur la dernière feuille
End With
End Sub
Sub CopieFeuille()
[COLOR="Red"][B]Sheets(Sheets.Count)[/B][/COLOR].Unprotect "zephir"
' Cette macro permet de créer une copie de la dernière feuille et de la placer en dernière position
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)