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

Signaler
Messages postés
18
Date d'inscription
mercredi 26 mai 2010
Statut
Membre
Dernière intervention
10 juin 2010
-
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
-
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

5 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
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.
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
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)
Messages postés
18
Date d'inscription
mercredi 26 mai 2010
Statut
Membre
Dernière intervention
10 juin 2010

D'accord je prend note!
Mais le programme ne fonctionne toujours pas...
HELP ME....
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
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
Messages postés
18
Date d'inscription
mercredi 26 mai 2010
Statut
Membre
Dernière intervention
10 juin 2010

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

qui ne fonctionne pas...