[Catégorie modifiée VB6 -- VBA] erreur 1004 "éxécution"Résolu

Question

Bonjour, je suis débutant en VB et je ddoir faire fonctionner ce programme qui fonctionne sous Excel garce à une macro ecrite en Vb. J'ai pu constater que certaine ligne ne fonctionnait pas. "Set ws = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))" sheets et add ne fonctionne pas... et d'autre souci divers... Merci d'avance^^ (voici le code) Option Explicit 'Ajoute une feuille au classeur si elle n'existe pas déjà 'sinon active la feuille demande et efface le contenu Private Function AddSheetIfNotExist(ByVal SheetName As String) As Worksheet Dim ws As Worksheet Dim Found As Boolean For Each ws In ActiveWorkbook.Worksheets If ws.Name = SheetName Then Found = True 'on efface cette feuille pour test ws.Cells.ClearContents Set AddSheetIfNotExist = ws End If Next If Not Found Then 'ajoute la nouvelle feuille à la suite des autres Set ws = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)) ws.Name = SheetName Set AddSheetIfNotExist = ws End If End Function Sub Vérification_générale() Dim NumLigne As Integer Dim NumColonne As Integer Dim j As Integer Dim nom As String 'garde une référence sur la feuille de vérification Dim WSVerif As Worksheet 'garde une référence sur la feuille de retard actuelle Dim WSRetard As Worksheet 'création d'une nouvelle feuille contenant les retards Set WSRetard = AddSheetIfNotExist("retard au " & DateTime.Date$) Set WSVerif = Sheets("Vérif") With WSRetard .Activate Call .Columns("A:K").Select 'largeur de la colonne de la nouvelle feuille Selection.ColumnWidth = 15.71 'je mets les noms aux colonnes Call WSVerif.Range("B1:K1").Copy 'sélection la cellule B1 avant de coller le contenu de B1:K1 Call .Range("B1").Select Call .Paste .UsedRange.Rows(1).EntireRow.Select Selection.Orientation = 90 Selection.RowHeight = 97.5 Selection.WrapText = True End With NumLigne = 4 'première ligne d'agence 'pour chaque colonne For NumColonne = 2 To 11 ' tant qu'il y a des agences dans la colonne While Not IsEmpty(WSVerif.Range("A" & NumLigne)) 'je test si la case est vide, puisque dans ce cas le calcul ne doit pas être fait If Not IsEmpty(WSVerif.Cells(NumLigne, NumColonne)) Then 'pour chaque agence, je test la date If WSVerif.Range("M28").Value > WSVerif.Cells(NumLigne, NumColonne).Value + WSVerif.Cells(3, NumColonne).Value Then 'si la date est passé, je change la couleur de la case Sheets("Vérif").Cells(NumLigne, NumColonne).Interior.ColorIndex = 3 'puis je met le nom de l'agence en question dans le tableau de la nouvelle feuille à la première case vide WSRetard.Cells(2, NumColonne).Select j = 3 WSRetard.Cells(j, NumColonne).Value = WSVerif.Range("A" & NumLigne).Value End If End If ' j'incrémente la variable de boucle NumLigne = NumLigne + 1 Wend NumLigne = 4 'on remet le compteur à la première ligne Next NumColonne WSRetard.Range("A1").Select Call envoi_mail(WSVerif, WSRetard) Set WSRetard = Nothing Set WSVerif = Nothing End Sub Public Sub envoi_mail(ByRef WSVerif As Worksheet, ByRef WSRetard As Worksheet) Dim corps As String Dim NumColonne Dim NumLigne As Integer Dim Nbpb As Integer Dim olApp As Object Dim ligne As Integer Dim NomAgence As String Dim ObjMail As Object NumLigne = 4 'première ligne d'agence ' pour chaque agence, on cherche quelles colonnes sont en retard Set olApp = CreateObject("Outlook.Application") While Not IsEmpty(WSVerif.Range("A" & NumLigne).Value) NomAgence = WSVerif.Range("A" & NumLigne).Value 'le corps du message est contenu dans la variable "corps" corps = "Mesdames et Messieurs, Veuillez trouver ci-après la liste des vérifications périodiques en retard dans votre agence. " & _ "Si aucune liste présente ci-dessous, vos visites périodiques sont donc à jour. " Nbpb = 0 For NumColonne = 2 To 11 ligne = 2 While Not IsEmpty(WSRetard.Cells(ligne, NumColonne)) 'si c'est l'agence à laquelle on souhaite ecrire If WSRetard.Cells(ligne, NumColonne) = NomAgence Then 'on ajoute l'entete de colonne (la raison du retard) corps = corps & Sheets(Worksheets.Count).Cells(1, NumColonne) & " " Nbpb = Nbpb + 1 End If ligne = ligne + 1 Wend Next NumColonne If Nbpb <> 0 Then corps = corps & "Merci de bien vouloir réguler la situation, si nécessaire, " & _ "dans les plus brefs délais et/ou nous transmettre une copie du rapport de vérification. " & _ "Merci de vérifier les dates de vos prochaines visites. Cordialement, Service QSE " & _ "Message généré automatiquement, pour toute remarque appeler le service prévention au 04.74.08.90.64" Set ObjMail = olApp.CreateItem(0) 'récupère et ajoute en destinaire le mails des responsables de chaque boites If Not IsEmpty(Sheets("adresses mail").Cells(NumLigne - 3, 2)) Then Call AddRecipient(Sheets("adresses mail").Cells(NumLigne - 3, 2), ObjMail) End If If Not IsEmpty(Sheets("adresses mail").Cells(NumLigne - 3, 3)) Then Call AddRecipient(Sheets("adresses mail").Cells(NumLigne - 3, 3), ObjMail) End If If Not IsEmpty(Sheets("adresses mail").Cells(NumLigne - 3, 3)) Then Call AddRecipient(Sheets("adresses mail").Cells(NumLigne - 3, 3), ObjMail) End If ObjMail.Subject = "retard vérification(s) périodique(s)" ObjMail.htmlbody = corps ObjMail.ReadReceiptRequested = False ObjMail.Send NumLigne = NumLigne + 1 End If Wend Set ObjMail = Nothing Set olApp = Nothing End Sub Private Sub AddRecipient(ByVal Destinataire As String, ByRef ObjMail As Object) If Destinataire <> vbNullString Then Call ObjMail.Recipients.Add(Destinataire) End Sub

cs_Jack · Accepted Answer

Bon, on va remettre le compteur à zéro.

Au début, tu nous dis que cette instruction pose problème :
"Set ws = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count))" 

Maintenant, tu en présentes une nouvelle.

Faut être clair, on a autre chose à faire que de lire entre les lignes (sans jeu de mot).
Alors dis nous (*) où se trouve ton problème, dis nous autre chose que "ça marche pas" : on se doute bien que si tu es là, c'est pour un problème, mais ce n'est pas à nous de trouver les erreurs, on ne pourra que t'aiguiller vers une solution.
DONC : Explique où ça coince, quelle erreur.
Quand une instruction comme la dernière dont tu nous parles, il y a deux sources d'erreur : La condition du If et l'action du If.
Pour pouvoir deboguer efficacement, mieux vaus découper en plusieurs lignes :
If maCondition Then
  Mon action
End If
De cette manière, l'erreur visera UNE instruction.

(*) Reposte une nouvelle question bien expliquée. Rappelle toi qu'on n'a pas ton programme sous les yeux et qu'on ne sait pas dans quel environnement tu te trouves.

cs_Jack · Answer

Salut

-1- Sous Excel, tu fais du VBA, pas du VB6
-2- Quand tu colles du code, merci d'utiliser la coloration syntaxisue = 3ème icone à droite
-3- Tant de code pour rien : ne décourage pas le lecteur : ne colle que le code en rapport avec ton problème

Ta fonction est correcte.
Peut-être faudrait-il rappeler le ActiveWorkBook partout où tu fais référence à un Worksheet, on ne sait jamais :
  Set ws = ActiveWorkbook.Sheets.Add( _ 
     After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
Dasn ta boucle de recherche d'une feuille existante, pense à faire un Exit For pour économiser des tours de code.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

doudou69820 · Answer

D'accord je prend note!
Mais le programme ne fonctionne toujours pas...
HELP ME....

cs_Jack · Answer

Bah chez moi, ça fonctionne.
Alors si tu as des erreurs, il serait temps de dire lesquelles.
As-tu suivi le cheminenment de ton programme en mode debug ?
F9 sur une ligne puis F8

doudou69820 · Answer

Oui, et j'ai = 
If Destinataire <> vbNullString Then Call ObjMail.Recipients.Add(Destinataire)

qui ne fonctionne pas...

[Catégorie modifiée VB6 --> VBA] erreur 1004 "éxécution"

5 réponses

Votre réponse

Discussions similaires