Compression de fichier en ZIP (VBA)

Bonjour à tous:

Voici mon problème, au cours de mon programme, je souhaite compresser un fichier en .ZIP. Mon applis se bloque au moment où WINZIP s'ouvre et le message suivant suivant apparait ===> voir PJ

Voici ma macro, en rouge figure l'endroit du bug
Merci pour votre aide
Bonne journée à tous

Dim p, d, groupe(0 To 50) As String
Dim i, j, t, t1, ok, maxlig As Integer
Declare Function WaitForSingleObject Lib "Kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Declare Function OpenProcess Lib "Kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Public Const INFINITE = &HFFFF

Sub compilation_bp04()
'supprime temporairement les messages d'alerte et la mise à jour de l'écran
Application.DisplayAlerts = False

Workbooks("data.xls").Sheets(1).Cells(16, 6) = "Ouverture des fichiers BP04 en cours ..."
Application.ScreenUpdating = False
p = ActiveWorkbook.Path
maxlig = 300

'Enregistrement sous databis.xls
Workbooks("data.xls").Activate
Workbooks("data.xls").Sheets(1).Cells(16, 6) = "Copie de data.xls (S-1) en databis.xls"
'Workbooks("data.xls").Sheets(1).Cells(18, 6) = Workbooks("data.xls").Sheets(2).Cells(4, 10).Text
Application.ScreenUpdating = True
Application.ScreenUpdating = False
ActiveWorkbook.SaveAs Filename:=p + "\databis.xls"

'ouverture des fichiers
t = 0
While Cells(t + 2, 1) <> ""
    groupe(t) = Cells(t + 2, 1).Value
    Workbooks.Open Filename:=p + "\" + groupe(t) + ".xls"
    Workbooks("databis.xls").Activate
    Sheets("Index").Select
    t = t + 1
Wend

'Copie des feuilles BDDF,DRBP, GROUPES
t = 0
While groupe(t) <> ""
    Windows(groupe(t) & ".xls").Activate
    Sheets(1).Select
    'Sheets(1).Copy after:=Workbooks("databis.xls").Sheets(t + 1)
    Range("A1:I" & maxlig).Select
    Selection.Copy
    Workbooks("databis.xls").Activate
    Sheets(t + 2).Select
    Sheets(t + 2).Name = groupe(t) 'BDDF,DR,GROUPES
    Range("B1").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Windows(groupe(t) & ".xls").Activate
    ActiveWorkbook.Close
    t = t + 1
Wend

'Tri des feuilles
Workbooks("databis.xls").Sheets(1).Cells(16, 6) = " Tri des zones de données en cours ..."
Application.ScreenUpdating = True
Application.ScreenUpdating = False
For j = 2 To Sheets.Count: Sheets(j).Select: Range("A7:J" & maxlig).Select
Selection.Sort Key1:=Range("A7"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next j

'ajout d'une colonne a gauche avec le code et Nb ou Cx
'For t = 2 To Sheets.Count
'    Sheets(t).Activate
'    'Range("A1:I" &maxlig).Select
'    'Selection.Copy
'    'Range("B1").Select
'    'ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
'    '    IconFileName:=False
'    Range("A7").Select
'    ActiveCell.FormulaR1C1 = "=RC[1] &""_"" &RC[3]"
'    Range("A7").Select
'    Selection.Copy
'    Range("A8:A" & maxlig).Select
'    ActiveSheet.Paste
'    Range("A1").Select
'Next t

'test si le contrôle des fichiers est valide
Sheets("Index").Select
If Range("F6").Text = "Erreur" Then
    MsgBox "Anomalie dans les fichiers! Refermer sans enregistrer.", vbExclamation, "Attention"
    GoTo fin
End If

'Enregistrement sous date de cumul
Sheets(1).Select
Sheets(1).Cells(16, 6) = "Archivage du Data.xls ..."
Application.ScreenUpdating = True 'pour afficher le message
Application.ScreenUpdating = False
Sheets(1).Cells(16, 6) = ""
Sheets(groupe(0)).Select
d = Mid(Range("J4").Value, 10) 'cumul au jj mois année
Sheets(1).Select
Range("F18").Value = d
'd1 = "Data_" & Right(d, 2) & Right("0" & Month(d), 2) & Left(d, 2)
d1 = "Data_" & "S" & Right("0" & Cells(19, 6).Text, 2)
ActiveWorkbook.SaveAs Filename:=p & "\" & d1 & ".xls"
'Enregistrement sous data.xls
Cells(16, 6) = "Enregistrement data.xls ..."
Application.ScreenUpdating = True
Application.ScreenUpdating = False
Sheets(1).Cells(16, 6) = ""
ActiveWorkbook.SaveAs Filename:=p & "\data.xls"
'archivage du data en zip
'Répertoire ou est installé WinZip
'===> CheminWinZip = "C:\Program Files\WinZip\Winzip8.1_FR\"
'Nom du fichier Zip a créér
'===> NomArchive = p & "\Data\" & d1 & ".zip"
'Nom du dossier à compresser
'===> QuelFichier = p & "\" & d1 & ".xls"
'===> chemin = CheminWinZip & "winzip32.exe -a """ & NomArchive & """ """ & QuelFichier & """"
'===> While LanceEtAttendLaFin(chemin) <> 0: Wend 'teste si le zip est terminé
'===> Kill p & "\" & d1 & ".xls"

fin:
Application.ScreenUpdating = True
MsgBox "Traitement terminé!", vbExclamation, "Fusion des feuilles"
ActiveWorkbook.Close savechanges = True
Application.DisplayAlerts = True
End Sub

Function LanceEtAttendLaFin(ByVal CheminComplet As String) As Long
Dim ProcessHandle As Long
Dim ProcessId As Long, ret&
ProcessId = Shell(CheminComplet, vbNormalFocus)
ProcessHandle = OpenProcess(&H1F0000, 0, ProcessId)
LanceEtAttendLaFin = WaitForSingleObject(ProcessHandle, INFINITE)
End Function

Salut,

Quelle est cette PJ dont tu parles ? Quel est le contenu du message de winzip ? S'il s'agit de la fenêtre relative à l'enregistrement du programme, tu peux essayer de simuler le clic sur le bon bouton... Si c'est ça tu peux aussi utiliser un autre outil que WINZIP pour compresser au format ZIP sans avoir de message à l'écran. Regarde par exemple du côté de 7zip (http://www.7-zip.org/fr/).

Bonjour

Tu est sûr que c'est du .NET, ça reseemble vachement à du VBA.
Qu'est-ce PJ ?
Color ton code, c'est quasiement illisible :
http://charles.racaud.free.fr/code-syntaxing/

Balèse la personne qui a pensé au pansement à penser (ou à panser, pensée).
VB (6, .NET1&2), C++, C#.Net1
Mon site

Bonjour

As-tu déjà essayé la fonction que j'ai développée et déposée sur ce site ?  Elle permet d'utiliser la fonction ZIP de Windows et donc de se passer de WinZip. 

Christophe