Discussion :

[ptitepunk]

Bonjour,

Je souhaiterais afficher une msgbox et cliquer en automatique sur OK
Comment faire ?

Merci d'avance

[argyronet]

Bonjour,

Disons que c'est possible mais complexe par rapport à l'étendue de ta question (voir ici un code de Randy...)

Le mieux pour toi est de construire un formulaire Msgbox temporisé avec le timer...

Argy

[ptitepunk]

est-il possible de répondre en automatique si la personne n'a pas répondu au bout de 1 minute par exemple

en fait j'aurais aussi besoinde faire une tempo car j'utilise word pour convertir des fichiers html en txt mais l'ouverture succésive et trop rapide de word me créer un message d'erreur "normal.dot à été modifier..." et word ne se referme plus en automatique j'ai essayé de faire une tempo avec une boucle mais cela ne fonction pas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
    Set fs = Application.FileSearch
    With fs
        .LookIn = Chem & "\Import\Offres"
        .FileName = "*.htm"
        If .Execute() > 0 Then
            For I = 1 To .foundfiles.Count
                NomFichier = .foundfiles(I)
                'Ouverture du *.htm dans word
                Set WdApp = CreateObject("Word.Application")
                With WdApp
                    'Ouverture du document
                    .Documents.Open NomFichier
                    .activedocument.SaveAs FileName:=Left(NomFichier, Len(NomFichier) - 3) & "txt", FileFormat:= _
                    wdFormatTextLineBreaks, LockComments:=False, Password:="", _
                    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
                    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
                    :=False, SaveAsAOCELetter:=False
                    'Ferme le document
                    .Documents.Close
                    .Application.Quit
'                    MsgBox "", vbInformation
                End With
                Set WdApp = Nothing
                'Temporisation
                For Tempo = 1 To 5000000
                Next Tempo
                DoCmd.Maximize
                MsgBox ("")
 
            Next I
        End If
    End With

Par contre si je met une msg box comme celle qui est en commentaire et que je clique sur ok, pas de message d'erreur de la part de word, c'est pourquoi je souhaite répondre automatiquement car pour l'utilisateur il serais barbant de cliquez une centaine de fois sur OK.

[argyronet]

Non, pas avec un Msgbox de façon simple (voir précédent post)....
Oui, je t'ai dis un formulaire temporisé à 1 minute (60000).
Regarde du coté de la propriété Minuterie

argy

[pgz]

Bonjour,

Pour éviter les messages à la fermeture de word, tu devrais compléter tes instructions .Close et .Quit par les paramètres qui précisent ce qui doit être sauvegardé et ce qui ne doit pas. Ce sont ces absences de consignes qui génèrent les messages.

Bonne chance,

pgz

[argyronet]

Ah, oui... je n'avais pas capté ta requête...
Vois avec ce qu'a suggéré PGZ... je ne suis pas certain que cela agisse comme tu le souhaites
Mais autrement, dans ta boucle, tu peux très bien vérifier que l'instance Word est toujours active auquel cas tu ne Loop pas tout de suite.
Ainsi, pas besoin de Msgbox dans ton code...

Pour vérifier que ton instance Word est toujours la, il te faut connaître son Handle grâce à son PID... (Et voir les codes source de ce forum)...
Une fois que tu le tiens tu mets en place une routine qui vérifie qu'elle tourne toujours après quoi tu Loop pour le fichier suivant...

Argy

[ptitepunk]

Dans mon code, je ferme bien le document puis l'appli

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
 
Set fs = Application.FileSearch 
    With fs 
        .LookIn = Chem & "\Import\Offres" 
        .FileName = "*.htm" 
        If .Execute() > 0 Then 
            For I = 1 To .foundfiles.Count 
                NomFichier = .foundfiles(I) 
                'Ouverture du *.htm dans word 
                Set WdApp = CreateObject("Word.Application") 
                With WdApp 
                    'Ouverture du document 
                    .Documents.Open NomFichier 
                    .activedocument.SaveAs FileName:=Left(NomFichier, Len(NomFichier) - 3) & "txt", FileFormat:= _ 
                    wdFormatTextLineBreaks, LockComments:=False, Password:="", _ 
                    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _ 
                    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _ 
                    :=False, SaveAsAOCELetter:=False 
                    'Ferme le document 
                    [color=red][b].Documents.Close 
                    .Application.Quit [/b][/color]
'                    MsgBox "", vbInformation 
                End With 
                Set WdApp = Nothing 
                'Temporisation 
                For Tempo = 1 To 5000000 
                Next Tempo 
                DoCmd.Maximize 
                MsgBox ("") 
 
            Next I 
        End If 
    End With 
 
mais la réouverture de celle-ci se fait trop vite et donc message d'erreur

[pgz]

Re,

Pourquoi fermer l'appli?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Set fs = Application.FileSearch 
    With fs 
        ...
                Set WdApp = CreateObject("Word.Application") 
                With WdApp 
 
            For I = 1 To .foundfiles.Count 
                NomFichier = .foundfiles(I) 
                'Ouverture du *.htm dans word 
                                    'Ouverture du document 
                    .Documents.Open NomFichier 
                    .activedocument.SaveAs ....
                    'Ferme le document 
                   .ActiveDocument.Close wdDoNotSaveChanges
 
'                            
            Next I 
          .Application.Quit  wdDoNotSaveChanges
           End With

pgz

[ptitepunk]

j'essai en ouvrant l'appli avant ma boucle et en la refermant qu'après ma boucle et je vous redit.
De toute façon message bizarre car même message sur 2 postes et pas de message sur le 3eme ???

[ptitepunk]

Ce n'est pas la solution, il ouvre autant de fois word qu'il y a de document et n'en referme qu'un

[ptitepunk]

Résolu avec une minuterie dont voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
Dim PauseTime, Start, Finish
'Temporisation
PauseTime = 5    ' Définit la durée.
Start = Timer    ' Définit l'heure de début.
Do While Timer < Start + PauseTime
    DoEvents    ' Donne le contrôle à d'autres processus.
Loop
Finish = Timer    ' Définit l'heure de fin.

Merci beaucoup

[argyronet]

Tu aurais pu aussi faire comme ceci (et sans MsgBox):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub ConvertHtmToTxt()
Dim oFSO As New FileSystemObject
Dim oFLD As Scripting.Folder
Dim oFile As File
Dim oWdApp As Word.Application
Dim I As Integer
Dim strPath As String
Dim strFilename As String
Const wdFormatText = 2
Const wdAlertsNone = 0
 
  On Error GoTo ErrorHandler
  strPath = "C:\Documents and Settings\Argyronet\Mes documents\Test_HTM_Txt"
  Set oWdApp = CreateObject("Word.Application")
  Set oFLD = oFSO.GetFolder(strPath)
  For Each oFile In oFLD.Files
    If Right(oFile.Name, 3) = "htm" Or Right(oFile.Name, 4) = "html" Then
      strFilename = strPath & "\" & oFile.Name
      I = I + 1
      With oWdApp
        .Visible = False
        .DisplayAlerts = wdAlertsNone
        .Documents.Open strFilename
        strFilename = Left(oFile.Name, InStr(1, oFile.Name, "htm", vbTextCompare) - 2) & ".txt"
        .ActiveDocument.SaveAs strPath & "\" & strFilename, wdFormatText
         DoEvents
        .ActiveDocument.Close False
      End With
    End If
  Next
  oWdApp.Quit wdDoNotSaveChanges
  MsgBox I & " fichiers de type HTM ont été convertis en texte (*.TXT)", 64, "Fin"
ExitHandler:
  Set oWdApp = Nothing
  Set oFLD = Nothing
  Set oFSO = Nothing
ErrorHandler:
  MsgBox Err.Description, 16, Err.Number
  Resume ExitHandler
End Sub

Argy