Convertir ma macro VBA sous Word2003 en VB6

Question

Bonjour je souhaite passer ma macro écrite sous VBA word2003 sous xp en VB6 surtout les traitements sous word (replace find etc..) je vous donne mon code c'est ce qui est en rouge que je voudrais changer je sais ouvrir un doc word mais pas traiter pourquoi traiter en VB6 ? d'une part je le converts en VB6 pour proteger mon code source avec un macro les gens peuvet la lire d'autre part l'instruction dir est aleatoir (il faut des msgbox au milieu pour que cela soit correct dans un repertoire de 100 fichiers tantot le pgrme en trouve 40 tantot 60 tantot 100 (boucle jusqu'au premier "" lecture nulle merci beaucoup NB ma macro word marche impeccable =========== ChangeFileOpenDirectory "C:\Applis\gedcorr" Documents.Open FileName:="copydl.bat", ConfirmConversions:=False, ReadOnly _ :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _ :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _ , Format:=wdOpenFormatAuto, XMLTransform:="", Encoding:=1252 Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = """" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll ActiveDocument.Save ActiveDocument.Close RetVal = Shell("C:\Applis\gedcorr\copydl.bat", 0) MsgBox "Début deprotection" WordBasic.disableinput 1 DoEvents 'ctptbl = 0 dirjm$ = "C:\Applis\gedcorr\delib" ChDir dirjm$ SFich = Dir(dirjm$ & "*.doc") premierdoc = SFich WordBasic.MsgBox " Premier Nom Fichier DOC", SFich, 64 nbidoc = 0 While SFich <> "" 'WordBasic.MsgBox " Nom Fichier" & Str(nbidoc), SFich, 64 dernierdoc = SFich SFich = Dir nbidoc = nbidoc + 1 Wend 'WordBasic.MsgBox " NBre Documents" & Str(nbidoc), SFICH, 64 lib$ = "Permier Document " + premierdoc + " Dernier Document " + dernierdoc WordBasic.MsgBox " NBre Documents" & Str(nbidoc), lib$, 64 'MsgBox "Début deprotection " & Str(nbidoc) Dim Today Today = Now debuj = Today dirjm$ = "C:\Applis\gedcorr\delab" SFich = Dir(dirjm$ & "*.doc") MsgBox "Suite deprotection" nbidoc = 0 While SFich <> "" fichier$ = "c:\applis\gedcorr\delib" + SFich 'WordBasic.MsgBox " Nelle version Nom Fichier" & Str(nbidoc), fichier$, 64 fichier$ = "c:\applis\gedcorr\delib" + SFich Documents.Open FileName:=fichier$, ConfirmConversions:=False, _ ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="123456", _ PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="" With ActiveDocument .ReadOnlyRecommended = False .Password = "" .WritePassword = "" .RemovePersonalInformation = False .RemoveDateAndTime = False End With With Options .WarnBeforeSavingPrintingSendingMarkup = False .StoreRSIDOnSave = True .ShowMarkupOpenSave = True End With ActiveDocument.Save ActiveDocument.Close 'MsgBox "on ferme" + SFICH If nbidoc = 0 Then premierjm = SFich Else dernierjm = SFich End If SFich = Dir nbidoc = nbidoc + 1 Wend Today = Now finj = Today 'WordBasic.MsgBox "h"libduree "Début " + Str(debuj) + " Fin = " + Str(finj)libdoc "Premier Doc " + premierjm + " Dernier Doc = " + dernierjm WordBasic.MsgBox " C'est fini NBre Documents" & Str(nbidoc), libdoc, 64 WordBasic.MsgBox " Documents deproteges dans c:applis\gedcorr\delib " & Str(nbidoc), libduree, 64 'WordBasic.MsgBox " C'est bien fini NBre Documents (avec durée) " & Str(nbidoc), libduree, 64

jrivet · Answer

Slut c'est juste pour comprendre la manière. Mais je n'ai pas pu testé Option Explicit 'Avec la référence Microsoft Word 9.0 Object Library '(9.0 ou équivalent) Private WApp As New Word.Application Private Sub Form_Load() With WApp Call .ChangeFileOpenDirectory("C:\Applis\gedcorr\") Call .Documents.Open("copydl.bat", False, False, False, vbNullString, vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, 1252) With .Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = """" .Replacement.Text = vbNullString .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Call .Execute(Replace:=wdReplaceAll) End With Call .ActiveDocument.Save Call .ActiveDocument.Close RetVal = Shell("C:\Applis\gedcorr\copydl.bat", 0) Call MsgBox("Début deprotection") Call .WordBasic.disableinput(1) DoEvents dirjm$ = "C:\Applis\gedcorr\delib\" Call ChDir(dirjm$) SFich = Dir(dirjm$ & "*.doc") premierdoc = SFich Call .WordBasic.MsgBox(" Premier Nom Fichier DOC", SFich, 64) nbidoc = 0 While SFich <> vbNullString dernierdoc = SFich SFich = Dir nbidoc = nbidoc + 1 Wend lib$ = "Permier Document " + premierdoc + " Dernier Document " + dernierdoc Call WordBasic.MsgBox(" NBre Documents" & Str(nbidoc), lib$, 64) Dim Today Today = Now debuj = Today dirjm$ = "C:\Applis\gedcorr\delab\" SFich = Dir(dirjm$ & "*.doc") Call MsgBox("Suite deprotection") nbidoc = 0 While SFich <> vbNullString fichier$ = "c:\applis\gedcorr\delib\" & SFich Call .Documents.Open(fichier$, False, False, False, "123456", vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, XMLTransform:="") With .ActiveDocument .ReadOnlyRecommended = False .Password = vbNullString .WritePassword = vbNullString .RemovePersonalInformation = False .RemoveDateAndTime = False End With With .Options .WarnBeforeSavingPrintingSendingMarkup = False .StoreRSIDOnSave = True .ShowMarkupOpenSave = True End With Call .ActiveDocument.Save Call .ActiveDocument.Close 'pas l'air très utile ca If nbidoc = 0 Then premierjm = SFich Else dernierjm = SFich End If SFich = Dir nbidoc = nbidoc + 1 Wend Today = Now finj = Today libduree "Début " & Str(debuj) & " Fin = " & Str(finj) libdoc "Premier Doc " & premierjm & " Dernier Doc = " & dernierjm Call .WordBasic.MsgBox(" C'est fini NBre Documents" & Str(nbidoc), libdoc, 64) Call .WordBasic.MsgBox(" Documents deproteges dans c:applis\gedcorr\delib " & Str(nbidoc), libduree, 64) End With End Sub

, ---- [code.aspx?ID=41455 By Renfield] @+: Ju£i?n Pensez: Réponse acceptée

Carambarip · Answer

Merci j'ai essayé et sur la ligne

Call .ChangeFileOpenDirectory("C:\Applis\gedcorr")



j'ai le message d'erreur 424
un objet est requis

peut-etre faut-il rajouter  des references ou autres objets à mon VB6 ?

question subsidaire 
comment as-tu fait pour convertir ? aussi vite

merci encore

jrivet · Answer

Salut,
"peut-etre faut-il rajouter  des references ou autres objets à mon VB6 ?" As tu regarder la premiere ligne du code qui disait 'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)

Est ce que tu as copier/coller ? As tu bien mis le NEW

@+: Ju£i?n
Pensez: Réponse acceptée

Carambarip · Answer

oui j'ai bien mis le new

je suis en word 11 (2003 sous sp2)

mais dans l'aide sur l'erreur le systeme me dit d'installer MSDN ?
comment faire ?

jrivet · Answer

Salut,
Non non le problème ne vient pas du fait que tu n'ai pas la MSDN... 

Allons  y petit a petit.

Est ce que ceci fonctionne
Option Explicit
'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)
Private WApp As New Word.Application

Private Sub Form_Load()
   
   Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr\")
   
End Sub , ----
[code.aspx?ID=41455 By Renfield]

Si la ca ne marche pas on a un souci car chez moi ca fonctionne

@+: Ju£i?n
Pensez: Réponse acceptée

Carambarip · Answer

Sub Command1_Click()
Option Explicit
'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)
Private WApp As New Word.Application


Private Sub Form_Load()
   
   Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr")
   
End Sub
End Sub

le l'ai mis sur un bouton il rale à propos de sub

Carambarip · Answer

voila exactement mon code que j'ai installe sur le click d'un bouton je n'ai rien mis en declarations ===================== Private Sub Command1_Click() ' CREDELIB01 Macro ' Lecture des noms de delibs issus de sql et ecriture de delib.bat ' Open "C:\Applis\gedcorr\delib.txt" For Input As #1 Open "C:\Applis\gedcorr\copydl.bat" For Output As #2 Write #2, "cd c:\applis\gedcorr\delib" Write #2, "erase *.doc" nbdoc = 0 dirjm$ = "C:\Applis\gedcorr\delib" deblec: ' Line Input #1, chemincomplet$ YA = Mid(chemincomplet$, 1, 11) YB = Mid(chemincomplet$, 1, 29) If YA <> "J:\GEDPROD" Then GoTo finlec nbdoc = nbdoc + 1 ' Line Input #1, deux$ numdefinitif$ = RTrim(deux$) lg = Len(numdefinitif$) 'MsgBox lg ZA = Mid(numdefinitif$, 1, 3) ZB = Mid(numdefinitif$, 3, 2) + Mid(numdefinitif$, 6, (lg - 5)) ZC = Mid(numdefinitif$, 3, 2) If ZA <> "200" Then GoTo ersiecl mypos = InStr(1, "07080910111213141516", ZC) If mypos = 0 Then GoTo erannee ecr$ = "copy " + YB + " C:" + ZB + ".DOC" 'MsgBox " j écrisA" + ecr$ Write #2, ecr$ 'MsgBox " j écris" + ecr$ Line Input #1, blanc$ 'MsgBox "blanc =>" + blanc$ + "<" GoTo deblec GoTo finlec ersiecl: MsgBox "ce n'est pas un siécle 200" + ZA GoTo fin erannee: MsgBox "ce n'est pas une ANNEE" + ZC GoTo fin errgedpro: MsgBox "ce n'est pas j:gedprod" + YA GoTo fin finlec: Write #2, "cd c:\applis\gedcorr\delab" Write #2, "erase *.doc" Write #2, "copy c:\applis\gedcorr\delib\*.* c:"libjm$ "Nombre documents écrits " + Str(nbdoc) MsgBox libjm$ MsgBox "C' est fini executer credelib2" fin: Close #1 Close #2 Private WApp As New Word.Application MsgBox "a" Private Sub Form_Load() Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr") End Sub 'Private WApp As New Word.Application Private Sub Form_Load() With WApp Call .ChangeFileOpenDirectory("C:\Applis\gedcorr") Call .Documents.Open("copydl.bat", False, False, False, vbNullString, vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, 1252) With .Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = """" .Replacement.Text = vbNullString .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Call .Execute(Replace:=wdReplaceAll) End With Call .ActiveDocument.Save Call .ActiveDocument.Close RetVal = Shell("C:\Applis\gedcorr\copydl.bat", 0) Call MsgBox("Début deprotection") Call .WordBasic.disableinput(1) DoEvents dirjm$ = "C:\Applis\gedcorr\delib" Call ChDir(dirjm$) SFich = Dir(dirjm$ & "*.doc") premierdoc = SFich Call .WordBasic.MsgBox(" Premier Nom Fichier DOC", SFich, 64) nbidoc = 0 While SFich <> vbNullString dernierdoc = SFich SFich = Dir nbidoc = nbidoc + 1 Wend lib$ = "Permier Document " + premierdoc + " Dernier Document " + dernierdoc Call WordBasic.MsgBox(" NBre Documents" & Str(nbidoc), lib$, 64) Dim Today Today = Now debuj = Today dirjm$ = "C:\Applis\gedcorr\delab" SFich = Dir(dirjm$ & "*.doc") Call MsgBox("Suite deprotection") nbidoc = 0 While SFich <> vbNullString fichier$ = "c:\applis\gedcorr\delib" & SFich Call .Documents.Open(fichier$, False, False, False, "123456", vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, XMLTransform:="") With .ActiveDocument .ReadOnlyRecommended = False .Password = vbNullString .WritePassword = vbNullString .RemovePersonalInformation = False .RemoveDateAndTime = False End With With .Options .WarnBeforeSavingPrintingSendingMarkup = False .StoreRSIDOnSave = True .ShowMarkupOpenSave = True End With Call .ActiveDocument.Save Call .ActiveDocument.Close 'pas l'air très utile ca If nbidoc = 0 Then premierjm = SFich Else dernierjm = SFich End If SFich = Dir nbidoc = nbidoc + 1 Wend Today = Now finj = Today libduree "Début " & Str(debuj) & " Fin = " & Str(finj) libdoc "Premier Doc " & premierjm & " Dernier Doc = " & dernierjm Call .WordBasic.MsgBox(" C'est fini NBre Documents" & Str(nbidoc), libdoc, 64) Call .WordBasic.MsgBox(" Documents deproteges dans c:applis\gedcorr\delib " & Str(nbidoc), libduree, 64) End With End Sub ========== ps 'pas l'air très utile ca If nbidoc = 0 Then premierjm = SFich Else dernierjm = SFich End If SFich = Dir nbidoc = nbidoc + 1 cela me sert à afficher en fin de programme le premier fichier lu et le dernier ls dir fonctionne mal merci encore

jrivet · Answer

Re,
Ou lala, STOP.
Tu copie et colle n'importe comment.
Il faut essayer d'être un peu Logique
CECI EST IMPOSSIBLE EN VB6
Sub Command1_Click()
Option Explicit
'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)
Private WApp As New Word.Application

Private Sub Form_Load()
 
  Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr\")
 
End Sub<hr />End Sub , ----
[code.aspx?ID=  41455 By Renfield]
Essaie de faire un copier coller Bête et méchant dans un nouveau projet du premier code que je te propose.

NOTE:
Lorsque tu vois ceci
Option Explicit
  'Avec la référence Microsoft Word 9.0 Object Library  
'(9.0 ou équivalent)
Private WApp As New Word.Application

C'est à placer dans le sDéclaration en haut Option Explicit ne sera JAMAIS dans une Sub ou une Fonction.
Le mot clé Private ne sera JAMAIS non plus dans une sub ou une Fonction.

@+: =89254 Ju£i?n
Pensez: Réponse acceptée

Carambarip · Answer

soit  mais tu écrivais :
Option Explicit
'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)
Private WApp As New Word.Application

Private Sub Form_Load()
   
   Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr\")
   
End Sub , ----
By Renfield
=je mets
Option Explicit
'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)
Private WApp As New Word.Application
dans les déclarations
et  ça 
Private Sub Form_Load()
   
   Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr")
   
End Sub 

le le mets où ?

Carambarip · Answer

soit  mais tu écrivais :
Option Explicit
'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)
Private WApp As New Word.Application

Private Sub Form_Load()
   
   Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr\")
   
End Sub , ----
By Renfield
=je mets
Option Explicit
'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)
Private WApp As New Word.Application
dans les déclarations
et  ça 
Private Sub Form_Load()
   
   Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr")
   
End Sub 

le le mets où ?

jrivet · Answer

Salut,
Form_load est l'événement qui survient au chargement d'une feuille VB6
Dans tu le mets dans une feuille.
Si tu veux vraiment passer par un bouton (qui est dans une feuille aussi)
alors mets ceci.

Option Explicit
'Avec la référence Microsoft Word 9.0 Object Library
'(9.0 ou équivalent)
Private WApp As New Word.Application

'Evenement survenant lors du click
'sur le bouton appelé Command1
Private Sub Command1_Click()
   Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr\")
End Sub<hr />

, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée

Carambarip · Answer

bonjour


ok je vais essayer


pourquoi mettre explicit ? et pourqoui private ? est-ce obligatoire ?


apparemment si je mets cette option 


toutes les donnees que j'utilise dans le code doivent etre definies dans les declarations
pourquoi private ?

désolé de poser ces questions

jrivet · Answer

Salut,
Option Explicit t'oblige à déclarer tes variables (pas forcément tout en haut)
Exemple

ceci donne une erreur
Option Explicit

Private Sub Command1_Click()
   i = 2
End Sub<hr />, ----
[code.aspx?ID=41455 By Renfield]
Car tu fais appelles à la variable i SANS l'avoir déclarer, il faut donc déclarer i soit en dans la déclaration pour quelle soit connue de toute la feuille soit dans Command1_Click Mais alors elle ne sera utilisable que dans Command1_Click

Donc:
Option Explicit
'Soit Dim i As Integer

Private Sub Command1_Click()
'Soit Dim i as Integer
   i = 2
End Sub , ----
[code.aspx?ID=41455 By Renfield]
Pour le Private, c'est la portée de la variable

@+: Ju£i?n
Pensez: Réponse acceptée

Carambarip · Answer

c'est bon ça marche j'ai mis dans decalarations Private WApp As New Word.Application Dim finjm voici le code entier du programme j'ai encore 3 problèmes 1 je n'arrive pas à sortir avec le bouton quitter (j'ai un doevents pourtant) mais le click sur le bouton quitter est inopérant 2 Le traitement est beaucoup plus long qu'avec la macro word 3 Comment Sortir du Programme en fin j'ai word ouvert (il doit falloir faire un quit de word et un exit au niveau du pgme vb6 Private Sub Command1_Click() finjm = 0 ' CREDELIB01 Macro ' Lecture des noms de delibs issus de sql et ecriture de delib.bat ' Open "C:\Applis\gedcorr\delib.txt" For Input As #1 Open "C:\Applis\gedcorr\copydl.bat" For Output As #2 Write #2, "cd c:\applis\gedcorr\delib" Write #2, "erase *.doc" nbdoc = 0 dirjm$ = "C:\Applis\gedcorr\delib" deblec: ' Line Input #1, chemincomplet$ YA = Mid(chemincomplet$, 1, 11) YB = Mid(chemincomplet$, 1, 29) If YA <> "J:\GEDPROD" Then GoTo finlec nbdoc = nbdoc + 1 ' Line Input #1, deux$ numdefinitif$ = RTrim(deux$) lg = Len(numdefinitif$) 'MsgBox lg ZA = Mid(numdefinitif$, 1, 3) ZB = Mid(numdefinitif$, 3, 2) + Mid(numdefinitif$, 6, (lg - 5)) ZC = Mid(numdefinitif$, 3, 2) If ZA <> "200" Then GoTo ersiecl mypos = InStr(1, "07080910111213141516", ZC) If mypos = 0 Then GoTo erannee ecr$ = "copy " + YB + " C:" + ZB + ".DOC" 'MsgBox " j écrisA" + ecr$ Write #2, ecr$ 'MsgBox " j écris" + ecr$ Line Input #1, blanc$ 'MsgBox "blanc =>" + blanc$ + "<" GoTo deblec GoTo finlec ersiecl: MsgBox "ce n'est pas un siécle 200" + ZA GoTo fin erannee: MsgBox "ce n'est pas une ANNEE" + ZC GoTo fin errgedpro: MsgBox "ce n'est pas j:gedprod" + YA GoTo fin finlec: Write #2, "cd c:\applis\gedcorr\delab" Write #2, "erase *.doc" Write #2, "copy c:\applis\gedcorr\delib\*.* c:"libjm$ "Nombre documents écrits " + Str(nbdoc) MsgBox libjm$ MsgBox "C' est fini executer credelib2" fin: Close #1 Close #2 Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr") Call WApp.Documents.Open("copydl.bat", False, False, False, vbNullString, vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, 1252) With WApp.Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = """" .Replacement.Text = vbNullString .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Call .Execute(Replace:=wdReplaceAll) End With Call WApp.ActiveDocument.Save Call WApp.ActiveDocument.Close RetVal = Shell("C:\Applis\gedcorr\copydl.bat", 0) Call MsgBox("Début deprotection") Call WApp.WordBasic.disableinput(1) DoEvents dirjm$ = "C:\Applis\gedcorr\delib" Call ChDir(dirjm$) SFich = Dir(dirjm$ & "*.doc") premierdoc = SFich Call WApp.WordBasic.MsgBox(" Premier Nom Fichier DOC", SFich, 64) nbidoc = 0 While SFich <> vbNullString dernierdoc = SFich SFich = Dir nbidoc = nbidoc + 1 Wend lib$ = "Permier Document " + premierdoc + " Dernier Document " + dernierdoc Call WApp.WordBasic.MsgBox(" NBre Documents" & Str(nbidoc), lib$, 64) Dim Today Today = Now debuj = Today dirjm$ = "C:\Applis\gedcorr\delab" SFich = Dir(dirjm$ & "*.doc") Call MsgBox("Suite deprotection") nbidoc = 0 While SFich <> vbNullString If finjm = 1 Then GoTo finjm End If fichier$ = "c:\applis\gedcorr\delib" & SFich Call WApp.Documents.Open(fichier$, False, False, False, "X78FG14", vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, XMLTransform:="") With WApp.ActiveDocument .ReadOnlyRecommended = False .Password = vbNullString .WritePassword = vbNullString .RemovePersonalInformation = False .RemoveDateAndTime = False End With With WApp.Options .WarnBeforeSavingPrintingSendingMarkup = False .StoreRSIDOnSave = True .ShowMarkupOpenSave = True End With Call WApp.ActiveDocument.Save Call WApp.ActiveDocument.Close 'pas l'air très utile ca If nbidoc = 0 Then premierjm = SFich Else dernierjm = SFich End If SFich = Dir nbidoc = nbidoc + 1 Wend Today = Now finj = Today libduree "Début " & Str(debuj) & " Fin = " & Str(finj) libdoc "Premier Doc " & premierjm & " Dernier Doc = " & dernierjm Call WApp.WordBasic.MsgBox(" C'est fini NBre Documents" & Str(nbidoc), libdoc, 64) Call WApp.WordBasic.MsgBox(" Documents deproteges dans c:applis\gedcorr\delib " & Str(nbidoc), libduree, 64) finjm: MsgBox "fin" + Str(finjm) + "a" End Sub Private Sub Command2_Click() finjm = 1 End Sub

jrivet · Answer

Salut,
Il faut chercher un peu.
POur quitter Word essaie la méthode Quit de l'objet WApp (déclarer comme Word.application) => Logique non?
Donc WApp.Quit
(Sans oublier la destruction des objets.)

Pour quitter un programme VB6 il faut décharger les feuilles. (si pas de feuille utilisation de l'instruction End)

Dim finjm : ??? c'est quoi ca?

@+: Ju£i?n
Pensez: Réponse acceptée

Carambarip · Answer

fijnm
c'est un indicateur qui me permet de savoir qu'on a cliqué sur le bouton quitter

A 0 en début de programme

et mis à 1 quand on clique sur bouton quitter

or malgre le click sur quitter
j'ai toujours 0 dans cette variable que j'ai définie au début dans les déclaration générales
ce qui semble demontrer que le doevents ne marche pas

merci

Carambarip · Answer

Voila mon programme il marche impeccable un seul point je veux voir sur ma feuille s'afficher au fur et à mesure de l'ouverture des documents words les noms de fichiers or ils s'affichent aleatoirement (le nom de mon champ text dans l'ecran est nomdoc) j'aimerais voir s'afficher titi 1 sur 151 tito 2 sur 151 tita 3 sur 151 or je ne vois que 54 55 56 et puis 72 (au hasard) c'est un probleme de liberation de ressource idem pour le click sur un bouton 2 malgre le clic le programme ne m'affiche pas j'ai cliqué j'ai pourtant mis des doevents j'ai bien mis u timer Private WApp As New Word.Application Dim finjm Private Sub Command1_Click() finjm = 0 ' CREDELIB01 Macro ' Lecture des noms de delibs issus de sql et ecriture de delib.bat Open "C:\Applis\gedcorr\delib.sql" For Output As #3 ecr$ = "set heading off" Write #3, ecr$ ecr$ = "set pages 0" Write #3, ecr$ ecr$ = "set heading off" Write #3, ecr$ ecr$ = "set pages 0" Write #3, ecr$ ecr$ = "spool c:\applis\gedcorr\delib.txt" Write #3, ecr$ ecr$ = "select delib_word , NUM_DEFINITIF from seance_dossier , dossier" Write #3, ecr$ ecr$ = "Where" Write #3, ecr$ecr$ "seance_ref TO_DATE('14-05-2007 16:00:00',"ecr$ "seance_ref TO_DATE(" + nomdoc + "," Write #3, ecr$ecr$ "'DD-MM-YYYY HH24:MI:SS') and seance_dossier.dossier_ref dossier.dossier_ref;" Write #3, ecr$ ecr$ = "select '999999999999999999999999999999' from dual;" Write #3, ecr$ ecr$ = "spool off" Write #3, ecr$ ecr$ = "exit" Write #3, ecr$ Close #3 Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr") Call WApp.Documents.Open("delib.sql", False, False, False, vbNullString, vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, 1252) With WApp.Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = """" .Replacement.Text = vbNullString .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Call .Execute(Replace:=wdReplaceAll) End With Call WApp.ActiveDocument.Save Call WApp.ActiveDocument.Close Retval = Shell("C:\Applis\gedcorr\delibl.bat", 0) Open "C:\Applis\gedcorr\delib.txt" For Input As #1 Open "C:\Applis\gedcorr\copydl.bat" For Output As #2 Write #2, "cd c:\applis\gedcorr\delib" Write #2, "erase *.doc" nbdoc = 0 dirjm$ = "C:\Applis\gedcorr\delib" deblec: ' Line Input #1, chemincomplet$ YA = Mid(chemincomplet$, 1, 11) YB = Mid(chemincomplet$, 1, 29) If YA <> "J:\GEDPROD" Then GoTo finlec nbdoc = nbdoc + 1 ' Line Input #1, deux$ numdefinitif$ = RTrim(deux$) lg = Len(numdefinitif$) 'MsgBox lg ZA = Mid(numdefinitif$, 1, 3) ZB = Mid(numdefinitif$, 3, 2) + Mid(numdefinitif$, 6, (lg - 5)) ZC = Mid(numdefinitif$, 3, 2) If ZA <> "200" Then GoTo ersiecl mypos = InStr(1, "07080910111213141516", ZC) If mypos = 0 Then GoTo erannee ecr$ = "copy " + YB + " C:" + ZB + ".DOC" 'MsgBox " j écrisA" + ecr$ Write #2, ecr$ 'MsgBox " j écris" + ecr$ Line Input #1, blanc$ 'MsgBox "blanc =>" + blanc$ + "<" GoTo deblec GoTo finlec ersiecl: MsgBox "ce n'est pas un siécle 200" + ZA GoTo fin erannee: MsgBox "ce n'est pas une ANNEE" + ZC GoTo fin errgedpro: MsgBox "ce n'est pas j:gedprod" + YA GoTo fin finlec: Write #2, "cd c:\applis\gedcorr\delab" Write #2, "erase *.doc" Write #2, "copy c:\applis\gedcorr\delib\*.* c:"libjm$ "Version du 1 juin Nombre documents écrits " + Str(nbdoc) MsgBox libjm$ MsgBox "C' est fini executer credelib2" fin: Close #1 Close #2 Call WApp.ChangeFileOpenDirectory("C:\Applis\gedcorr") Call WApp.Documents.Open("copydl.bat", False, False, False, vbNullString, vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, 1252) With WApp.Selection.Find .ClearFormatting .Replacement.ClearFormatting .Text = """" .Replacement.Text = vbNullString .Forward = True .Wrap = wdFindContinue .Format = False .MatchCase = False .MatchWholeWord = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False Call .Execute(Replace:=wdReplaceAll) End With Call WApp.ActiveDocument.Save Call WApp.ActiveDocument.Close Retval = Shell("C:\Applis\gedcorr\copydl.bat", 0) 'MsgBox "Retour copydl.bat" + Str(Retval) + "<===" Call MsgBox("Début deprotection") 'Call WApp.WordBasic.disableinput(1) DoEvents dirjm$ = "C:\Applis\gedcorr\delib" Call ChDir(dirjm$) SFich = Dir(dirjm$ & "*.doc") premierdoc = SFich Call WApp.WordBasic.MsgBox(" Premier Nom Fichier DOC", SFich, 64) nbidoct = 0 While SFich <> vbNullString dernierdoc = SFich SFich = Dir nbidoct = nbidoct + 1 Wend lib$ = "Permier Document " + premierdoc + " Dernier Document " + dernierdoc Call WApp.WordBasic.MsgBox(" NBre Documents" & Str(nbidoct), lib$, 64) Dim Today Today = Now debuj = Today dirjm$ = "C:\Applis\gedcorr\delab" SFich = Dir(dirjm$ & "*.doc") Call MsgBox("Suite deprotection") nbidoc = 0 DoEvents While SFich <> vbNullString If finjm = 1 Then GoTo finjm End If nomdoc = SFich + " " + Str(nbidoc + 1) + " sur " + Str(nbidoct) fichier$ = "c:\applis\gedcorr\delib" & SFich 'MsgBox "j'ouvre" + fichier$ Call WApp.Documents.Open(fichier$, False, False, False, "X78FG14", vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, XMLTransform:="") With WApp.ActiveDocument .ReadOnlyRecommended = False .Password = vbNullString .WritePassword = vbNullString .RemovePersonalInformation = False .RemoveDateAndTime = False End With With WApp.Options .WarnBeforeSavingPrintingSendingMarkup = False .StoreRSIDOnSave = True .ShowMarkupOpenSave = True End With Call WApp.ActiveDocument.Save Call WApp.ActiveDocument.Close 'pas l'air très utile ca If nbidoc = 0 Then premierjm = SFich Else dernierjm = SFich End If SFich = Dir nbidoc = nbidoc + 1 Wend Today = Now finj = Today libduree "Début " & Str(debuj) & " Fin = " & Str(finj) libdoc "Premier Doc " & premierjm & " Dernier Doc = " & dernierjm Call WApp.WordBasic.MsgBox(" C'est fini NBre Documents" & Str(nbidoc), libdoc, 64) Call WApp.WordBasic.MsgBox(" Documents deproteges dans c:applis\gedcorr\delib " & Str(nbidoc), libduree, 64) Call WApp.Quit finjm: MsgBox "fin" + Str(finjm) + "a" End Sub Private Sub Command2_Click() MsgBox "je clique" + Str(finjm) finjm = 1 MsgBox "je sors du clic" + Str(finjm) End Sub Private Sub Form_Load() nomdoc = "'14-05-2007 16:00:00'" End Sub

Carambarip · Answer

Bonjour

J'ai écrit 3 programmes VB
car malgré l'ecriture d'un fichier  ici delib.txt (généré par delibl.bat

Retval = Shell("C:\Applis\gedcorr\delibl.bat", 0)
lorsque j'ouvre le fichier delib.txt j'ouvre celui qui existait en début de programme

Open "C:\Applis\gedcorr\delib.txt" For Input As #1
Open "C:\Applis\gedcorr\copydl.bat" For Output As #2
=========
et ceci cloche aussi (il faut quitter le programme pour que les lectures 
des reprtoires delab et  delib se fassent correctement
     dirjm$ = "C:\Applis\gedcorr\delab"
       SFich = Dir(dirjm$ & "*.doc")
       Call MsgBox("Suite deprotection")
       nbidoc = 0
       DoEvents
       While SFich <> vbNullString
           If finjm = 1 Then
           GoTo finjm
           End If
            nomdoc = SFich + "  " + Str(nbidoc + 1) + " sur " + Str(nbidoct)
           fichier$ = "c:\applis\gedcorr\delib" & SFich
          'MsgBox "j'ouvre" + fichier$
           Call WApp.Documents.Open(fichier$, False, False, False, "X78FG14", vbNullString, False, vbNullString, vbNullString, wdOpenFormatAuto, XMLTransform:="")
                      With WApp.ActiveDocument

je n'arrive pas à ouvrir le fichier

Convertir ma macro VBA sous Word2003 en VB6

18 réponses

Votre réponse

Discussions similaires