Convertir ma macro VBA sous Word2003 en VB6

Signaler
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007
-
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007
-
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

18 réponses

Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
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<hr />, ----
[code.aspx?ID=41455 By Renfield]

@+: Ju£i?n
Pensez: Réponse acceptée
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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 ?
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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ù ?
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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ù ?
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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
Messages postés
7393
Date d'inscription
mercredi 23 avril 2003
Statut
Membre
Dernière intervention
6 avril 2012
58
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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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
Messages postés
12
Date d'inscription
jeudi 31 mai 2007
Statut
Membre
Dernière intervention
8 juin 2007

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