Bonjour a vous tous,
Sous access 2003, je transfers en vb des enregistrements dans un fichier
excel et j'ai une forme conditonnelle a appliquer .
Lorsque j'exécute la première fois tout est ok mais si je réexécute une
secondes fois, j'obtiens l'erreur 91.
Pour régler je dois fermer la BD et repartir. encore la je pense seulement
qu'une fois et la seconde fois ça ne marche pas.
Je plante à la ligne :
Selection.FormatConditions.Delete
Voici mon code :
Private Sub cmdGenerateExcelFile_Click()
On Error GoTo GestionErreur
Dim db As Database
Dim rstSousProjets As Recordset
Dim strsql As String
Dim strSheetName As String
Dim strfiltre, intColonne As String
Dim flgExcelOuvert As Boolean
Dim flgWbkOuvert As Boolean
Dim intFeuil As Integer, strTemplate As String
Dim countrecord, intLigne
DoCmd.Hourglass True
If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''") &
End If
If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
End If
If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet, "'",
"''") & "'"
End If
If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
If Me.mdStatusProjet = "Reçue" Then
strfiltre = strfiltre & " AND [Date reçue] is not null"
Else
strfiltre = strfiltre & " AND [Date reçue] is null"
End If
End If
If Me.ModTerme.Column(1) <> "" And Not IsNull(Me.ModTerme.Column(1))
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
End If
If strfiltre <> "" Then
strfiltre = "WHERE " & strfiltre
End If
'************************************************************************
' Changer la cible selon où est placé le fichier template
'************************************************************************
strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
Set db = CurrentDb()
Dim rstProjets As Recordset
Set rstProjets = db.OpenRecordset("SELECT [Projet Principal].Titre "
"FROM ([Projet Principal] LEFT JOIN
[Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & _
" GROUP BY [Projet Principal].Titre
& _
"ORDER BY [Projet
If rstProjets.EOF Then
MsgBox ("Aucun résultat disponible pour votre sélection")
Else
Dim XL As New Excel.Application
Dim wbk As Excel.Workbook
flgExcelOuvert = True
XL.Visible = True
Set wbk = XL.Workbooks.Add(strTemplate)
flgWbkOuvert = True
intFeuil = 1
rstProjets.MoveFirst
strSheetName = Left$(rstProjets("Titre"), 31)
strSheetName = Replace([strSheetName], "/", " ")
strSheetName = Replace([strSheetName], "*", " ")
strSheetName = Replace([strSheetName], "", " ")
strSheetName = Replace([strSheetName], "?", " ")
wbk.Sheets(intFeuil).name = strSheetName
wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
rstProjets.MoveNext
While Not rstProjets.EOF
wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
intFeuil = intFeuil + 1
wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
strSheetName = Left$(rstProjets("Titre"), 31)
strSheetName = Replace([strSheetName], "/", " ")
strSheetName = Replace([strSheetName], "*", " ")
strSheetName = Replace([strSheetName], "", " ")
strSheetName = Replace([strSheetName], "?", " ")
wbk.Sheets(intFeuil).name = strSheetName
Set rstSousProjets = db.OpenRecordset("SELECT
S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
date].[Date butoir], [suivi date].[date reçue] " & _
"FROM ([Projet Principal] LEFT JOIN [Type
pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & " AND [Projet Principal].Titre
"Order By [Sous-projet].[No S-projet
wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
intLigne = 6
While Not rstSousProjets.EOF
With wbk.Sheets(strSheetName)
.Range("A" & intLigne).Value = rstSousProjets("No S-projet
SAV")
.Range("B" & intLigne).Value rstSousProjets("DESCRIPTION")
.Range("C" & intLigne).Value = rstSousProjets("Contact")
.Range("D" & intLigne).Value rstSousProjets("Responsable")
.Range("E" & intLigne).Value = rstSousProjets("Date
.Range("F" & intLigne).Value = rstSousProjets("Date
.Range("G" & intLigne).Value = rstSousProjets("Date
.Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("G" & intLigne).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add type:=xlCellValue,
Operator:=xlGreater, Formula1:="=F" & intLigne
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add type:=xlCellValue,
Operator:=xlLess, Formula1:="=F" & intLigne
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 10
End With
End With
rstSousProjets.MoveNext
intLigne = intLigne + 1
Wend
rstSousProjets.Close
Set rstSousProjets = Nothing
rstProjets.MoveNext
Wend
'pour finir, on rempli la feuille 1 qui nous servait de template.
la gardait vide pour la copier.
rstProjets.MoveFirst
Set rstSousProjets = db.OpenRecordset("SELECT [Sous-projet].[No
S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
Responsable, [suivi date].contact, format([suivi date].[date
envoyé],'yyyy-mm-dd'), format([suivi date].[Date butoir],'yyyy-mm-dd'),
format([suivi date].[date reçue],'yyyy-mm-dd') " & _
"FROM ([Projet Principal] LEFT JOIN
pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & " AND [Projet
Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
"Order By [Sous-projet].[No S-projet
wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
wbk.Sheets(1).Columns("B:B").WrapText = True
wbk.Sheets(1).Select
wbk.Sheets(1).Cells(1, 1).Select
XL.Visible = True
Set XL = Nothing
rstProjets.Close
Set rstProjets = Nothing
Set db = Nothing
Set wbk = Nothing
End If
DoCmd.Hourglass False
Exit Sub
GestionErreur:
DoCmd.Hourglass False
If flgWbkOuvert = True Then
wbk.Close False
Set wbk = Nothing
End If
If flgExcelOuvert = True Then
XL.Quit
Set XL = Nothing
End If
If Err.Number <> 2501 Then
MsgBox Err.Number & " " & Err.Description
Else
MsgBox "Il n'y a pas de données pour les paramètres demandés.",
vbInformation
End If
End Sub
merci de m'aider car ça fair des heures que je piétine.
cordialement
Bonjour a vous tous,
Sous access 2003, je transfers en vb des enregistrements dans un fichier
excel et j'ai une forme conditonnelle a appliquer .
Lorsque j'exécute la première fois tout est ok mais si je réexécute une
secondes fois, j'obtiens l'erreur 91.
Pour régler je dois fermer la BD et repartir. encore la je pense seulement
qu'une fois et la seconde fois ça ne marche pas.
Je plante à la ligne :
Selection.FormatConditions.Delete
Voici mon code :
Private Sub cmdGenerateExcelFile_Click()
On Error GoTo GestionErreur
Dim db As Database
Dim rstSousProjets As Recordset
Dim strsql As String
Dim strSheetName As String
Dim strfiltre, intColonne As String
Dim flgExcelOuvert As Boolean
Dim flgWbkOuvert As Boolean
Dim intFeuil As Integer, strTemplate As String
Dim countrecord, intLigne
DoCmd.Hourglass True
If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''") &
End If
If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
End If
If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet, "'",
"''") & "'"
End If
If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
If Me.mdStatusProjet = "Reçue" Then
strfiltre = strfiltre & " AND [Date reçue] is not null"
Else
strfiltre = strfiltre & " AND [Date reçue] is null"
End If
End If
If Me.ModTerme.Column(1) <> "" And Not IsNull(Me.ModTerme.Column(1))
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
End If
If strfiltre <> "" Then
strfiltre = "WHERE " & strfiltre
End If
'************************************************************************
' Changer la cible selon où est placé le fichier template
'************************************************************************
strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
Set db = CurrentDb()
Dim rstProjets As Recordset
Set rstProjets = db.OpenRecordset("SELECT [Projet Principal].Titre "
"FROM ([Projet Principal] LEFT JOIN
[Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & _
" GROUP BY [Projet Principal].Titre
& _
"ORDER BY [Projet
If rstProjets.EOF Then
MsgBox ("Aucun résultat disponible pour votre sélection")
Else
Dim XL As New Excel.Application
Dim wbk As Excel.Workbook
flgExcelOuvert = True
XL.Visible = True
Set wbk = XL.Workbooks.Add(strTemplate)
flgWbkOuvert = True
intFeuil = 1
rstProjets.MoveFirst
strSheetName = Left$(rstProjets("Titre"), 31)
strSheetName = Replace([strSheetName], "/", " ")
strSheetName = Replace([strSheetName], "*", " ")
strSheetName = Replace([strSheetName], "", " ")
strSheetName = Replace([strSheetName], "?", " ")
wbk.Sheets(intFeuil).name = strSheetName
wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
rstProjets.MoveNext
While Not rstProjets.EOF
wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
intFeuil = intFeuil + 1
wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
strSheetName = Left$(rstProjets("Titre"), 31)
strSheetName = Replace([strSheetName], "/", " ")
strSheetName = Replace([strSheetName], "*", " ")
strSheetName = Replace([strSheetName], "", " ")
strSheetName = Replace([strSheetName], "?", " ")
wbk.Sheets(intFeuil).name = strSheetName
Set rstSousProjets = db.OpenRecordset("SELECT
S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
date].[Date butoir], [suivi date].[date reçue] " & _
"FROM ([Projet Principal] LEFT JOIN [Type
pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & " AND [Projet Principal].Titre
"Order By [Sous-projet].[No S-projet
wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
intLigne = 6
While Not rstSousProjets.EOF
With wbk.Sheets(strSheetName)
.Range("A" & intLigne).Value = rstSousProjets("No S-projet
SAV")
.Range("B" & intLigne).Value rstSousProjets("DESCRIPTION")
.Range("C" & intLigne).Value = rstSousProjets("Contact")
.Range("D" & intLigne).Value rstSousProjets("Responsable")
.Range("E" & intLigne).Value = rstSousProjets("Date
.Range("F" & intLigne).Value = rstSousProjets("Date
.Range("G" & intLigne).Value = rstSousProjets("Date
.Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("G" & intLigne).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add type:=xlCellValue,
Operator:=xlGreater, Formula1:="=F" & intLigne
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add type:=xlCellValue,
Operator:=xlLess, Formula1:="=F" & intLigne
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 10
End With
End With
rstSousProjets.MoveNext
intLigne = intLigne + 1
Wend
rstSousProjets.Close
Set rstSousProjets = Nothing
rstProjets.MoveNext
Wend
'pour finir, on rempli la feuille 1 qui nous servait de template.
la gardait vide pour la copier.
rstProjets.MoveFirst
Set rstSousProjets = db.OpenRecordset("SELECT [Sous-projet].[No
S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
Responsable, [suivi date].contact, format([suivi date].[date
envoyé],'yyyy-mm-dd'), format([suivi date].[Date butoir],'yyyy-mm-dd'),
format([suivi date].[date reçue],'yyyy-mm-dd') " & _
"FROM ([Projet Principal] LEFT JOIN
pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & " AND [Projet
Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
"Order By [Sous-projet].[No S-projet
wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
wbk.Sheets(1).Columns("B:B").WrapText = True
wbk.Sheets(1).Select
wbk.Sheets(1).Cells(1, 1).Select
XL.Visible = True
Set XL = Nothing
rstProjets.Close
Set rstProjets = Nothing
Set db = Nothing
Set wbk = Nothing
End If
DoCmd.Hourglass False
Exit Sub
GestionErreur:
DoCmd.Hourglass False
If flgWbkOuvert = True Then
wbk.Close False
Set wbk = Nothing
End If
If flgExcelOuvert = True Then
XL.Quit
Set XL = Nothing
End If
If Err.Number <> 2501 Then
MsgBox Err.Number & " " & Err.Description
Else
MsgBox "Il n'y a pas de données pour les paramètres demandés.",
vbInformation
End If
End Sub
merci de m'aider car ça fair des heures que je piétine.
cordialement
Bonjour a vous tous,
Sous access 2003, je transfers en vb des enregistrements dans un fichier
excel et j'ai une forme conditonnelle a appliquer .
Lorsque j'exécute la première fois tout est ok mais si je réexécute une
secondes fois, j'obtiens l'erreur 91.
Pour régler je dois fermer la BD et repartir. encore la je pense seulement
qu'une fois et la seconde fois ça ne marche pas.
Je plante à la ligne :
Selection.FormatConditions.Delete
Voici mon code :
Private Sub cmdGenerateExcelFile_Click()
On Error GoTo GestionErreur
Dim db As Database
Dim rstSousProjets As Recordset
Dim strsql As String
Dim strSheetName As String
Dim strfiltre, intColonne As String
Dim flgExcelOuvert As Boolean
Dim flgWbkOuvert As Boolean
Dim intFeuil As Integer, strTemplate As String
Dim countrecord, intLigne
DoCmd.Hourglass True
If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''") &
End If
If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
End If
If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet, "'",
"''") & "'"
End If
If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
If Me.mdStatusProjet = "Reçue" Then
strfiltre = strfiltre & " AND [Date reçue] is not null"
Else
strfiltre = strfiltre & " AND [Date reçue] is null"
End If
End If
If Me.ModTerme.Column(1) <> "" And Not IsNull(Me.ModTerme.Column(1))
If strfiltre <> "" Then
strfiltre = strfiltre & " AND "
End If
strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
End If
If strfiltre <> "" Then
strfiltre = "WHERE " & strfiltre
End If
'************************************************************************
' Changer la cible selon où est placé le fichier template
'************************************************************************
strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
Set db = CurrentDb()
Dim rstProjets As Recordset
Set rstProjets = db.OpenRecordset("SELECT [Projet Principal].Titre "
"FROM ([Projet Principal] LEFT JOIN
[Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & _
" GROUP BY [Projet Principal].Titre
& _
"ORDER BY [Projet
If rstProjets.EOF Then
MsgBox ("Aucun résultat disponible pour votre sélection")
Else
Dim XL As New Excel.Application
Dim wbk As Excel.Workbook
flgExcelOuvert = True
XL.Visible = True
Set wbk = XL.Workbooks.Add(strTemplate)
flgWbkOuvert = True
intFeuil = 1
rstProjets.MoveFirst
strSheetName = Left$(rstProjets("Titre"), 31)
strSheetName = Replace([strSheetName], "/", " ")
strSheetName = Replace([strSheetName], "*", " ")
strSheetName = Replace([strSheetName], "", " ")
strSheetName = Replace([strSheetName], "?", " ")
wbk.Sheets(intFeuil).name = strSheetName
wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
rstProjets.MoveNext
While Not rstProjets.EOF
wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
intFeuil = intFeuil + 1
wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
strSheetName = Left$(rstProjets("Titre"), 31)
strSheetName = Replace([strSheetName], "/", " ")
strSheetName = Replace([strSheetName], "*", " ")
strSheetName = Replace([strSheetName], "", " ")
strSheetName = Replace([strSheetName], "?", " ")
wbk.Sheets(intFeuil).name = strSheetName
Set rstSousProjets = db.OpenRecordset("SELECT
S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
date].[Date butoir], [suivi date].[date reçue] " & _
"FROM ([Projet Principal] LEFT JOIN [Type
pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & " AND [Projet Principal].Titre
"Order By [Sous-projet].[No S-projet
wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
intLigne = 6
While Not rstSousProjets.EOF
With wbk.Sheets(strSheetName)
.Range("A" & intLigne).Value = rstSousProjets("No S-projet
SAV")
.Range("B" & intLigne).Value rstSousProjets("DESCRIPTION")
.Range("C" & intLigne).Value = rstSousProjets("Contact")
.Range("D" & intLigne).Value rstSousProjets("Responsable")
.Range("E" & intLigne).Value = rstSousProjets("Date
.Range("F" & intLigne).Value = rstSousProjets("Date
.Range("G" & intLigne).Value = rstSousProjets("Date
.Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
.Range("G" & intLigne).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add type:=xlCellValue,
Operator:=xlGreater, Formula1:="=F" & intLigne
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 3
End With
Selection.FormatConditions.Add type:=xlCellValue,
Operator:=xlLess, Formula1:="=F" & intLigne
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 10
End With
End With
rstSousProjets.MoveNext
intLigne = intLigne + 1
Wend
rstSousProjets.Close
Set rstSousProjets = Nothing
rstProjets.MoveNext
Wend
'pour finir, on rempli la feuille 1 qui nous servait de template.
la gardait vide pour la copier.
rstProjets.MoveFirst
Set rstSousProjets = db.OpenRecordset("SELECT [Sous-projet].[No
S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
Responsable, [suivi date].contact, format([suivi date].[date
envoyé],'yyyy-mm-dd'), format([suivi date].[Date butoir],'yyyy-mm-dd'),
format([suivi date].[date reçue],'yyyy-mm-dd') " & _
"FROM ([Projet Principal] LEFT JOIN
pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
[Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
principal] = [Sous-projet].[No projet principal] " & _
strfiltre & " AND [Projet
Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
"Order By [Sous-projet].[No S-projet
wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
wbk.Sheets(1).Columns("B:B").WrapText = True
wbk.Sheets(1).Select
wbk.Sheets(1).Cells(1, 1).Select
XL.Visible = True
Set XL = Nothing
rstProjets.Close
Set rstProjets = Nothing
Set db = Nothing
Set wbk = Nothing
End If
DoCmd.Hourglass False
Exit Sub
GestionErreur:
DoCmd.Hourglass False
If flgWbkOuvert = True Then
wbk.Close False
Set wbk = Nothing
End If
If flgExcelOuvert = True Then
XL.Quit
Set XL = Nothing
End If
If Err.Number <> 2501 Then
MsgBox Err.Number & " " & Err.Description
Else
MsgBox "Il n'y a pas de données pour les paramètres demandés.",
vbInformation
End If
End Sub
merci de m'aider car ça fair des heures que je piétine.
cordialement
Bonjour,
As-tu essayé de remplacer
Selection.FormatConditions.Delete
Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
Formula1:="=F" & intLigne
par
Selection.FormatConditions.Modify type:=xlCellValue, Operator:=xlGreater,
Formula1:="=F" & intLigne
?
--
Cordialement,
Gilbert
"Gaya" a écrit dans le message de
news:
> Bonjour a vous tous,
>
> Sous access 2003, je transfers en vb des enregistrements dans un fichier
> excel et j'ai une forme conditonnelle a appliquer .
> Lorsque j'exécute la première fois tout est ok mais si je réexécute une
> secondes fois, j'obtiens l'erreur 91.
>
> Pour régler je dois fermer la BD et repartir. encore la je pense seulement
> qu'une fois et la seconde fois ça ne marche pas.
>
> Je plante à la ligne :
> Selection.FormatConditions.Delete
>
> Voici mon code :
>
>
> Private Sub cmdGenerateExcelFile_Click()
> On Error GoTo GestionErreur
> Dim db As Database
> Dim rstSousProjets As Recordset
> Dim strsql As String
> Dim strSheetName As String
> Dim strfiltre, intColonne As String
> Dim flgExcelOuvert As Boolean
> Dim flgWbkOuvert As Boolean
>
> Dim intFeuil As Integer, strTemplate As String
> Dim countrecord, intLigne
>
> DoCmd.Hourglass True
>
> If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''") &
"'"
> End If
>
> If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> End If
>
> If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet, "'",
> "''") & "'"
> End If
>
> If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> If Me.mdStatusProjet = "Reçue" Then
> strfiltre = strfiltre & " AND [Date reçue] is not null"
> Else
> strfiltre = strfiltre & " AND [Date reçue] is null"
> End If
> End If
>
> If Me.ModTerme.Column(1) <> "" And Not IsNull(Me.ModTerme.Column(1))
Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
Me.ModTerme.Column(1)
> End If
>
> If strfiltre <> "" Then
> strfiltre = "WHERE " & strfiltre
> End If
>
> '************************************************************************
> ' Changer la cible selon où est placé le fichier template
> '************************************************************************
> strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
>
> Set db = CurrentDb()
> Dim rstProjets As Recordset
> Set rstProjets = db.OpenRecordset("SELECT [Projet Principal].Titre "
& _
> "FROM ([Projet Principal] LEFT JOIN
> [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
LEFT
> JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & _
> " GROUP BY [Projet Principal].Titre
"
> & _
> "ORDER BY [Projet
Principal].Titre;")
>
> If rstProjets.EOF Then
> MsgBox ("Aucun résultat disponible pour votre sélection")
> Else
>
> Dim XL As New Excel.Application
> Dim wbk As Excel.Workbook
>
> flgExcelOuvert = True
>
> XL.Visible = True
>
> Set wbk = XL.Workbooks.Add(strTemplate)
> flgWbkOuvert = True
>
> intFeuil = 1
> rstProjets.MoveFirst
>
> strSheetName = Left$(rstProjets("Titre"), 31)
> strSheetName = Replace([strSheetName], "/", " ")
> strSheetName = Replace([strSheetName], "*", " ")
> strSheetName = Replace([strSheetName], "", " ")
> strSheetName = Replace([strSheetName], "?", " ")
> wbk.Sheets(intFeuil).name = strSheetName
> wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
>
> rstProjets.MoveNext
> While Not rstProjets.EOF
> wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> intFeuil = intFeuil + 1
> wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
>
> strSheetName = Left$(rstProjets("Titre"), 31)
> strSheetName = Replace([strSheetName], "/", " ")
> strSheetName = Replace([strSheetName], "*", " ")
> strSheetName = Replace([strSheetName], "", " ")
> strSheetName = Replace([strSheetName], "?", " ")
> wbk.Sheets(intFeuil).name = strSheetName
>
>
> Set rstSousProjets = db.OpenRecordset("SELECT
[Sous-projet].[No
> S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> date].[Date butoir], [suivi date].[date reçue] " & _
> "FROM ([Projet Principal] LEFT JOIN [Type
> pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
pub
> tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
> TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & " AND [Projet Principal].Titre
> > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> "Order By [Sous-projet].[No S-projet
SAV]")
>
> wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
>
> intLigne = 6
>
> While Not rstSousProjets.EOF
> With wbk.Sheets(strSheetName)
> .Range("A" & intLigne).Value = rstSousProjets("No S-projet
> SAV")
> .Range("B" & intLigne).Value > rstSousProjets("DESCRIPTION")
> .Range("C" & intLigne).Value = rstSousProjets("Contact")
> .Range("D" & intLigne).Value > rstSousProjets("Responsable")
> .Range("E" & intLigne).Value = rstSousProjets("Date
Envoyé")
> .Range("F" & intLigne).Value = rstSousProjets("Date
Butoir")
> .Range("G" & intLigne).Value = rstSousProjets("Date
Reçue")
>
> .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
>
> .Range("G" & intLigne).Select
> Selection.FormatConditions.Delete
> Selection.FormatConditions.Add type:=xlCellValue,
> Operator:=xlGreater, Formula1:="=F" & intLigne
>
> With Selection.FormatConditions(1).Font
> .Bold = True
> .Italic = False
> .ColorIndex = 3
> End With
> Selection.FormatConditions.Add type:=xlCellValue,
> Operator:=xlLess, Formula1:="=F" & intLigne
> With Selection.FormatConditions(2).Font
> .Bold = True
> .Italic = False
> .ColorIndex = 10
> End With
> End With
> rstSousProjets.MoveNext
> intLigne = intLigne + 1
> Wend
>
> rstSousProjets.Close
> Set rstSousProjets = Nothing
> rstProjets.MoveNext
> Wend
> 'pour finir, on rempli la feuille 1 qui nous servait de template.
On
> la gardait vide pour la copier.
> rstProjets.MoveFirst
> Set rstSousProjets = db.OpenRecordset("SELECT [Sous-projet].[No
> S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> Responsable, [suivi date].contact, format([suivi date].[date
> envoyé],'yyyy-mm-dd'), format([suivi date].[Date butoir],'yyyy-mm-dd'),
> format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> "FROM ([Projet Principal] LEFT JOIN
[Type
> pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
pub
> tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
> TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & " AND [Projet
> Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> "Order By [Sous-projet].[No S-projet
SAV]")
> wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
> wbk.Sheets(1).Columns("B:B").WrapText = True
> wbk.Sheets(1).Select
> wbk.Sheets(1).Cells(1, 1).Select
>
> XL.Visible = True
>
> Set XL = Nothing
> rstProjets.Close
> Set rstProjets = Nothing
> Set db = Nothing
> Set wbk = Nothing
>
> End If
>
> DoCmd.Hourglass False
> Exit Sub
> GestionErreur:
> DoCmd.Hourglass False
> If flgWbkOuvert = True Then
> wbk.Close False
> Set wbk = Nothing
> End If
> If flgExcelOuvert = True Then
> XL.Quit
> Set XL = Nothing
> End If
> If Err.Number <> 2501 Then
> MsgBox Err.Number & " " & Err.Description
> Else
> MsgBox "Il n'y a pas de données pour les paramètres demandés.",
> vbInformation
> End If
>
> End Sub
>
>
> merci de m'aider car ça fair des heures que je piétine.
>
> cordialement
>
Bonjour,
As-tu essayé de remplacer
Selection.FormatConditions.Delete
Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
Formula1:="=F" & intLigne
par
Selection.FormatConditions.Modify type:=xlCellValue, Operator:=xlGreater,
Formula1:="=F" & intLigne
?
--
Cordialement,
Gilbert
"Gaya" <Gaya@discussions.microsoft.com> a écrit dans le message de
news:AB4790B4-1D7B-4825-81A2-49CFF7F1C7BF@microsoft.com...
> Bonjour a vous tous,
>
> Sous access 2003, je transfers en vb des enregistrements dans un fichier
> excel et j'ai une forme conditonnelle a appliquer .
> Lorsque j'exécute la première fois tout est ok mais si je réexécute une
> secondes fois, j'obtiens l'erreur 91.
>
> Pour régler je dois fermer la BD et repartir. encore la je pense seulement
> qu'une fois et la seconde fois ça ne marche pas.
>
> Je plante à la ligne :
> Selection.FormatConditions.Delete
>
> Voici mon code :
>
>
> Private Sub cmdGenerateExcelFile_Click()
> On Error GoTo GestionErreur
> Dim db As Database
> Dim rstSousProjets As Recordset
> Dim strsql As String
> Dim strSheetName As String
> Dim strfiltre, intColonne As String
> Dim flgExcelOuvert As Boolean
> Dim flgWbkOuvert As Boolean
>
> Dim intFeuil As Integer, strTemplate As String
> Dim countrecord, intLigne
>
> DoCmd.Hourglass True
>
> If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''") &
"'"
> End If
>
> If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> End If
>
> If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet, "'",
> "''") & "'"
> End If
>
> If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> If Me.mdStatusProjet = "Reçue" Then
> strfiltre = strfiltre & " AND [Date reçue] is not null"
> Else
> strfiltre = strfiltre & " AND [Date reçue] is null"
> End If
> End If
>
> If Me.ModTerme.Column(1) <> "" And Not IsNull(Me.ModTerme.Column(1))
Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
Me.ModTerme.Column(1)
> End If
>
> If strfiltre <> "" Then
> strfiltre = "WHERE " & strfiltre
> End If
>
> '************************************************************************
> ' Changer la cible selon où est placé le fichier template
> '************************************************************************
> strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
>
> Set db = CurrentDb()
> Dim rstProjets As Recordset
> Set rstProjets = db.OpenRecordset("SELECT [Projet Principal].Titre "
& _
> "FROM ([Projet Principal] LEFT JOIN
> [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
LEFT
> JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & _
> " GROUP BY [Projet Principal].Titre
"
> & _
> "ORDER BY [Projet
Principal].Titre;")
>
> If rstProjets.EOF Then
> MsgBox ("Aucun résultat disponible pour votre sélection")
> Else
>
> Dim XL As New Excel.Application
> Dim wbk As Excel.Workbook
>
> flgExcelOuvert = True
>
> XL.Visible = True
>
> Set wbk = XL.Workbooks.Add(strTemplate)
> flgWbkOuvert = True
>
> intFeuil = 1
> rstProjets.MoveFirst
>
> strSheetName = Left$(rstProjets("Titre"), 31)
> strSheetName = Replace([strSheetName], "/", " ")
> strSheetName = Replace([strSheetName], "*", " ")
> strSheetName = Replace([strSheetName], "", " ")
> strSheetName = Replace([strSheetName], "?", " ")
> wbk.Sheets(intFeuil).name = strSheetName
> wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
>
> rstProjets.MoveNext
> While Not rstProjets.EOF
> wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> intFeuil = intFeuil + 1
> wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
>
> strSheetName = Left$(rstProjets("Titre"), 31)
> strSheetName = Replace([strSheetName], "/", " ")
> strSheetName = Replace([strSheetName], "*", " ")
> strSheetName = Replace([strSheetName], "", " ")
> strSheetName = Replace([strSheetName], "?", " ")
> wbk.Sheets(intFeuil).name = strSheetName
>
>
> Set rstSousProjets = db.OpenRecordset("SELECT
[Sous-projet].[No
> S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> date].[Date butoir], [suivi date].[date reçue] " & _
> "FROM ([Projet Principal] LEFT JOIN [Type
> pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
pub
> tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
> TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & " AND [Projet Principal].Titre
> > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> "Order By [Sous-projet].[No S-projet
SAV]")
>
> wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
>
> intLigne = 6
>
> While Not rstSousProjets.EOF
> With wbk.Sheets(strSheetName)
> .Range("A" & intLigne).Value = rstSousProjets("No S-projet
> SAV")
> .Range("B" & intLigne).Value > rstSousProjets("DESCRIPTION")
> .Range("C" & intLigne).Value = rstSousProjets("Contact")
> .Range("D" & intLigne).Value > rstSousProjets("Responsable")
> .Range("E" & intLigne).Value = rstSousProjets("Date
Envoyé")
> .Range("F" & intLigne).Value = rstSousProjets("Date
Butoir")
> .Range("G" & intLigne).Value = rstSousProjets("Date
Reçue")
>
> .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
>
> .Range("G" & intLigne).Select
> Selection.FormatConditions.Delete
> Selection.FormatConditions.Add type:=xlCellValue,
> Operator:=xlGreater, Formula1:="=F" & intLigne
>
> With Selection.FormatConditions(1).Font
> .Bold = True
> .Italic = False
> .ColorIndex = 3
> End With
> Selection.FormatConditions.Add type:=xlCellValue,
> Operator:=xlLess, Formula1:="=F" & intLigne
> With Selection.FormatConditions(2).Font
> .Bold = True
> .Italic = False
> .ColorIndex = 10
> End With
> End With
> rstSousProjets.MoveNext
> intLigne = intLigne + 1
> Wend
>
> rstSousProjets.Close
> Set rstSousProjets = Nothing
> rstProjets.MoveNext
> Wend
> 'pour finir, on rempli la feuille 1 qui nous servait de template.
On
> la gardait vide pour la copier.
> rstProjets.MoveFirst
> Set rstSousProjets = db.OpenRecordset("SELECT [Sous-projet].[No
> S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> Responsable, [suivi date].contact, format([suivi date].[date
> envoyé],'yyyy-mm-dd'), format([suivi date].[Date butoir],'yyyy-mm-dd'),
> format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> "FROM ([Projet Principal] LEFT JOIN
[Type
> pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
pub
> tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
> TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & " AND [Projet
> Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> "Order By [Sous-projet].[No S-projet
SAV]")
> wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
> wbk.Sheets(1).Columns("B:B").WrapText = True
> wbk.Sheets(1).Select
> wbk.Sheets(1).Cells(1, 1).Select
>
> XL.Visible = True
>
> Set XL = Nothing
> rstProjets.Close
> Set rstProjets = Nothing
> Set db = Nothing
> Set wbk = Nothing
>
> End If
>
> DoCmd.Hourglass False
> Exit Sub
> GestionErreur:
> DoCmd.Hourglass False
> If flgWbkOuvert = True Then
> wbk.Close False
> Set wbk = Nothing
> End If
> If flgExcelOuvert = True Then
> XL.Quit
> Set XL = Nothing
> End If
> If Err.Number <> 2501 Then
> MsgBox Err.Number & " " & Err.Description
> Else
> MsgBox "Il n'y a pas de données pour les paramètres demandés.",
> vbInformation
> End If
>
> End Sub
>
>
> merci de m'aider car ça fair des heures que je piétine.
>
> cordialement
>
Bonjour,
As-tu essayé de remplacer
Selection.FormatConditions.Delete
Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
Formula1:="=F" & intLigne
par
Selection.FormatConditions.Modify type:=xlCellValue, Operator:=xlGreater,
Formula1:="=F" & intLigne
?
--
Cordialement,
Gilbert
"Gaya" a écrit dans le message de
news:
> Bonjour a vous tous,
>
> Sous access 2003, je transfers en vb des enregistrements dans un fichier
> excel et j'ai une forme conditonnelle a appliquer .
> Lorsque j'exécute la première fois tout est ok mais si je réexécute une
> secondes fois, j'obtiens l'erreur 91.
>
> Pour régler je dois fermer la BD et repartir. encore la je pense seulement
> qu'une fois et la seconde fois ça ne marche pas.
>
> Je plante à la ligne :
> Selection.FormatConditions.Delete
>
> Voici mon code :
>
>
> Private Sub cmdGenerateExcelFile_Click()
> On Error GoTo GestionErreur
> Dim db As Database
> Dim rstSousProjets As Recordset
> Dim strsql As String
> Dim strSheetName As String
> Dim strfiltre, intColonne As String
> Dim flgExcelOuvert As Boolean
> Dim flgWbkOuvert As Boolean
>
> Dim intFeuil As Integer, strTemplate As String
> Dim countrecord, intLigne
>
> DoCmd.Hourglass True
>
> If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''") &
"'"
> End If
>
> If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> End If
>
> If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet, "'",
> "''") & "'"
> End If
>
> If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> If Me.mdStatusProjet = "Reçue" Then
> strfiltre = strfiltre & " AND [Date reçue] is not null"
> Else
> strfiltre = strfiltre & " AND [Date reçue] is null"
> End If
> End If
>
> If Me.ModTerme.Column(1) <> "" And Not IsNull(Me.ModTerme.Column(1))
Then
> If strfiltre <> "" Then
> strfiltre = strfiltre & " AND "
> End If
> strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
Me.ModTerme.Column(1)
> End If
>
> If strfiltre <> "" Then
> strfiltre = "WHERE " & strfiltre
> End If
>
> '************************************************************************
> ' Changer la cible selon où est placé le fichier template
> '************************************************************************
> strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
>
> Set db = CurrentDb()
> Dim rstProjets As Recordset
> Set rstProjets = db.OpenRecordset("SELECT [Projet Principal].Titre "
& _
> "FROM ([Projet Principal] LEFT JOIN
> [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
LEFT
> JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & _
> " GROUP BY [Projet Principal].Titre
"
> & _
> "ORDER BY [Projet
Principal].Titre;")
>
> If rstProjets.EOF Then
> MsgBox ("Aucun résultat disponible pour votre sélection")
> Else
>
> Dim XL As New Excel.Application
> Dim wbk As Excel.Workbook
>
> flgExcelOuvert = True
>
> XL.Visible = True
>
> Set wbk = XL.Workbooks.Add(strTemplate)
> flgWbkOuvert = True
>
> intFeuil = 1
> rstProjets.MoveFirst
>
> strSheetName = Left$(rstProjets("Titre"), 31)
> strSheetName = Replace([strSheetName], "/", " ")
> strSheetName = Replace([strSheetName], "*", " ")
> strSheetName = Replace([strSheetName], "", " ")
> strSheetName = Replace([strSheetName], "?", " ")
> wbk.Sheets(intFeuil).name = strSheetName
> wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
>
> rstProjets.MoveNext
> While Not rstProjets.EOF
> wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> intFeuil = intFeuil + 1
> wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
>
> strSheetName = Left$(rstProjets("Titre"), 31)
> strSheetName = Replace([strSheetName], "/", " ")
> strSheetName = Replace([strSheetName], "*", " ")
> strSheetName = Replace([strSheetName], "", " ")
> strSheetName = Replace([strSheetName], "?", " ")
> wbk.Sheets(intFeuil).name = strSheetName
>
>
> Set rstSousProjets = db.OpenRecordset("SELECT
[Sous-projet].[No
> S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> date].[Date butoir], [suivi date].[date reçue] " & _
> "FROM ([Projet Principal] LEFT JOIN [Type
> pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
pub
> tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
> TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & " AND [Projet Principal].Titre
> > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> "Order By [Sous-projet].[No S-projet
SAV]")
>
> wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
>
> intLigne = 6
>
> While Not rstSousProjets.EOF
> With wbk.Sheets(strSheetName)
> .Range("A" & intLigne).Value = rstSousProjets("No S-projet
> SAV")
> .Range("B" & intLigne).Value > rstSousProjets("DESCRIPTION")
> .Range("C" & intLigne).Value = rstSousProjets("Contact")
> .Range("D" & intLigne).Value > rstSousProjets("Responsable")
> .Range("E" & intLigne).Value = rstSousProjets("Date
Envoyé")
> .Range("F" & intLigne).Value = rstSousProjets("Date
Butoir")
> .Range("G" & intLigne).Value = rstSousProjets("Date
Reçue")
>
> .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
>
> .Range("G" & intLigne).Select
> Selection.FormatConditions.Delete
> Selection.FormatConditions.Add type:=xlCellValue,
> Operator:=xlGreater, Formula1:="=F" & intLigne
>
> With Selection.FormatConditions(1).Font
> .Bold = True
> .Italic = False
> .ColorIndex = 3
> End With
> Selection.FormatConditions.Add type:=xlCellValue,
> Operator:=xlLess, Formula1:="=F" & intLigne
> With Selection.FormatConditions(2).Font
> .Bold = True
> .Italic = False
> .ColorIndex = 10
> End With
> End With
> rstSousProjets.MoveNext
> intLigne = intLigne + 1
> Wend
>
> rstSousProjets.Close
> Set rstSousProjets = Nothing
> rstProjets.MoveNext
> Wend
> 'pour finir, on rempli la feuille 1 qui nous servait de template.
On
> la gardait vide pour la copier.
> rstProjets.MoveFirst
> Set rstSousProjets = db.OpenRecordset("SELECT [Sous-projet].[No
> S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> Responsable, [suivi date].contact, format([suivi date].[date
> envoyé],'yyyy-mm-dd'), format([suivi date].[Date butoir],'yyyy-mm-dd'),
> format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> "FROM ([Projet Principal] LEFT JOIN
[Type
> pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No type
pub
> tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT JOIN
> TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
employé].[No
> employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
Projet
> principal] = [Sous-projet].[No projet principal] " & _
> strfiltre & " AND [Projet
> Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> "Order By [Sous-projet].[No S-projet
SAV]")
> wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
> wbk.Sheets(1).Columns("B:B").WrapText = True
> wbk.Sheets(1).Select
> wbk.Sheets(1).Cells(1, 1).Select
>
> XL.Visible = True
>
> Set XL = Nothing
> rstProjets.Close
> Set rstProjets = Nothing
> Set db = Nothing
> Set wbk = Nothing
>
> End If
>
> DoCmd.Hourglass False
> Exit Sub
> GestionErreur:
> DoCmd.Hourglass False
> If flgWbkOuvert = True Then
> wbk.Close False
> Set wbk = Nothing
> End If
> If flgExcelOuvert = True Then
> XL.Quit
> Set XL = Nothing
> End If
> If Err.Number <> 2501 Then
> MsgBox Err.Number & " " & Err.Description
> Else
> MsgBox "Il n'y a pas de données pour les paramètres demandés.",
> vbInformation
> End If
>
> End Sub
>
>
> merci de m'aider car ça fair des heures que je piétine.
>
> cordialement
>
Bonsoir gilbert,
Je viens d'essayer ta suggestion et malheureusement j'ai maintenant
438 propriété ou méthode non géré par l'objet.
"Gilbert" a écrit :
> Bonjour,
>
> As-tu essayé de remplacer
> Selection.FormatConditions.Delete
> Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
> Formula1:="=F" & intLigne
> par
> Selection.FormatConditions.Modify type:=xlCellValue,
> Formula1:="=F" & intLigne
> ?
> --
> Cordialement,
>
> Gilbert
>
>
> "Gaya" a écrit dans le message de
> news:
> > Bonjour a vous tous,
> >
> > Sous access 2003, je transfers en vb des enregistrements dans un
> > excel et j'ai une forme conditonnelle a appliquer .
> > Lorsque j'exécute la première fois tout est ok mais si je réexécute
> > secondes fois, j'obtiens l'erreur 91.
> >
> > Pour régler je dois fermer la BD et repartir. encore la je pense
> > qu'une fois et la seconde fois ça ne marche pas.
> >
> > Je plante à la ligne :
> > Selection.FormatConditions.Delete
> >
> > Voici mon code :
> >
> >
> > Private Sub cmdGenerateExcelFile_Click()
> > On Error GoTo GestionErreur
> > Dim db As Database
> > Dim rstSousProjets As Recordset
> > Dim strsql As String
> > Dim strSheetName As String
> > Dim strfiltre, intColonne As String
> > Dim flgExcelOuvert As Boolean
> > Dim flgWbkOuvert As Boolean
> >
> > Dim intFeuil As Integer, strTemplate As String
> > Dim countrecord, intLigne
> >
> > DoCmd.Hourglass True
> >
> > If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> > strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''")
> "'"
> > End If
> >
> > If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> > End If
> >
> > If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet,
> > "''") & "'"
> > End If
> >
> > If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> > If Me.mdStatusProjet = "Reçue" Then
> > strfiltre = strfiltre & " AND [Date reçue] is not null"
> > Else
> > strfiltre = strfiltre & " AND [Date reçue] is null"
> > End If
> > End If
> >
> > If Me.ModTerme.Column(1) <> "" And Not
> Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
> Me.ModTerme.Column(1)
> > End If
> >
> > If strfiltre <> "" Then
> > strfiltre = "WHERE " & strfiltre
> > End If
> >
> >
> > ' Changer la cible selon où est placé le fichier template
> >
> > strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
> >
> > Set db = CurrentDb()
> > Dim rstProjets As Recordset
> > Set rstProjets = db.OpenRecordset("SELECT [Projet
> & _
> > "FROM ([Projet Principal] LEFT
> > [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub
> > type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
> LEFT
> > JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & _
> > " GROUP BY [Projet
> "
> > & _
> > "ORDER BY [Projet
> Principal].Titre;")
> >
> > If rstProjets.EOF Then
> > MsgBox ("Aucun résultat disponible pour votre sélection")
> > Else
> >
> > Dim XL As New Excel.Application
> > Dim wbk As Excel.Workbook
> >
> > flgExcelOuvert = True
> >
> > XL.Visible = True
> >
> > Set wbk = XL.Workbooks.Add(strTemplate)
> > flgWbkOuvert = True
> >
> > intFeuil = 1
> > rstProjets.MoveFirst
> >
> > strSheetName = Left$(rstProjets("Titre"), 31)
> > strSheetName = Replace([strSheetName], "/", " ")
> > strSheetName = Replace([strSheetName], "*", " ")
> > strSheetName = Replace([strSheetName], "", " ")
> > strSheetName = Replace([strSheetName], "?", " ")
> > wbk.Sheets(intFeuil).name = strSheetName
> > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> >
> > rstProjets.MoveNext
> > While Not rstProjets.EOF
> > wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> > intFeuil = intFeuil + 1
> > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> >
> > strSheetName = Left$(rstProjets("Titre"), 31)
> > strSheetName = Replace([strSheetName], "/", " ")
> > strSheetName = Replace([strSheetName], "*", " ")
> > strSheetName = Replace([strSheetName], "", " ")
> > strSheetName = Replace([strSheetName], "?", " ")
> > wbk.Sheets(intFeuil).name = strSheetName
> >
> >
> > Set rstSousProjets = db.OpenRecordset("SELECT
> [Sous-projet].[No
> > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> > date].[Date butoir], [suivi date].[date reçue] " & _
> > "FROM ([Projet Principal] LEFT JOIN
> > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> pub
> > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
> > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & " AND [Projet
> > > > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> > "Order By [Sous-projet].[No S-projet
> SAV]")
> >
> > wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
> >
> > intLigne = 6
> >
> > While Not rstSousProjets.EOF
> > With wbk.Sheets(strSheetName)
> > .Range("A" & intLigne).Value = rstSousProjets("No
> > SAV")
> > .Range("B" & intLigne).Value > > rstSousProjets("DESCRIPTION")
> > .Range("C" & intLigne).Value rstSousProjets("Contact")
> > .Range("D" & intLigne).Value > > rstSousProjets("Responsable")
> > .Range("E" & intLigne).Value = rstSousProjets("Date
> Envoyé")
> > .Range("F" & intLigne).Value = rstSousProjets("Date
> Butoir")
> > .Range("G" & intLigne).Value = rstSousProjets("Date
> Reçue")
> >
> > .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> >
> > .Range("G" & intLigne).Select
> > Selection.FormatConditions.Delete
> > Selection.FormatConditions.Add type:=xlCellValue,
> > Operator:=xlGreater, Formula1:="=F" & intLigne
> >
> > With Selection.FormatConditions(1).Font
> > .Bold = True
> > .Italic = False
> > .ColorIndex = 3
> > End With
> > Selection.FormatConditions.Add type:=xlCellValue,
> > Operator:=xlLess, Formula1:="=F" & intLigne
> > With Selection.FormatConditions(2).Font
> > .Bold = True
> > .Italic = False
> > .ColorIndex = 10
> > End With
> > End With
> > rstSousProjets.MoveNext
> > intLigne = intLigne + 1
> > Wend
> >
> > rstSousProjets.Close
> > Set rstSousProjets = Nothing
> > rstProjets.MoveNext
> > Wend
> > 'pour finir, on rempli la feuille 1 qui nous servait de
> On
> > la gardait vide pour la copier.
> > rstProjets.MoveFirst
> > Set rstSousProjets = db.OpenRecordset("SELECT
> > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > Responsable, [suivi date].contact, format([suivi date].[date
> > envoyé],'yyyy-mm-dd'), format([suivi date].[Date
> > format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> > "FROM ([Projet Principal] LEFT JOIN
> [Type
> > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> pub
> > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
> > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & " AND [Projet
> > Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' "
> > "Order By [Sous-projet].[No S-projet
> SAV]")
> > wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
> > wbk.Sheets(1).Columns("B:B").WrapText = True
> > wbk.Sheets(1).Select
> > wbk.Sheets(1).Cells(1, 1).Select
> >
> > XL.Visible = True
> >
> > Set XL = Nothing
> > rstProjets.Close
> > Set rstProjets = Nothing
> > Set db = Nothing
> > Set wbk = Nothing
> >
> > End If
> >
> > DoCmd.Hourglass False
> > Exit Sub
> > GestionErreur:
> > DoCmd.Hourglass False
> > If flgWbkOuvert = True Then
> > wbk.Close False
> > Set wbk = Nothing
> > End If
> > If flgExcelOuvert = True Then
> > XL.Quit
> > Set XL = Nothing
> > End If
> > If Err.Number <> 2501 Then
> > MsgBox Err.Number & " " & Err.Description
> > Else
> > MsgBox "Il n'y a pas de données pour les paramètres
> > vbInformation
> > End If
> >
> > End Sub
> >
> >
> > merci de m'aider car ça fair des heures que je piétine.
> >
> > cordialement
> >
>
>
>
Bonsoir gilbert,
Je viens d'essayer ta suggestion et malheureusement j'ai maintenant
438 propriété ou méthode non géré par l'objet.
"Gilbert" a écrit :
> Bonjour,
>
> As-tu essayé de remplacer
> Selection.FormatConditions.Delete
> Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
> Formula1:="=F" & intLigne
> par
> Selection.FormatConditions.Modify type:=xlCellValue,
> Formula1:="=F" & intLigne
> ?
> --
> Cordialement,
>
> Gilbert
>
>
> "Gaya" <Gaya@discussions.microsoft.com> a écrit dans le message de
> news:AB4790B4-1D7B-4825-81A2-49CFF7F1C7BF@microsoft.com...
> > Bonjour a vous tous,
> >
> > Sous access 2003, je transfers en vb des enregistrements dans un
> > excel et j'ai une forme conditonnelle a appliquer .
> > Lorsque j'exécute la première fois tout est ok mais si je réexécute
> > secondes fois, j'obtiens l'erreur 91.
> >
> > Pour régler je dois fermer la BD et repartir. encore la je pense
> > qu'une fois et la seconde fois ça ne marche pas.
> >
> > Je plante à la ligne :
> > Selection.FormatConditions.Delete
> >
> > Voici mon code :
> >
> >
> > Private Sub cmdGenerateExcelFile_Click()
> > On Error GoTo GestionErreur
> > Dim db As Database
> > Dim rstSousProjets As Recordset
> > Dim strsql As String
> > Dim strSheetName As String
> > Dim strfiltre, intColonne As String
> > Dim flgExcelOuvert As Boolean
> > Dim flgWbkOuvert As Boolean
> >
> > Dim intFeuil As Integer, strTemplate As String
> > Dim countrecord, intLigne
> >
> > DoCmd.Hourglass True
> >
> > If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> > strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''")
> "'"
> > End If
> >
> > If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> > End If
> >
> > If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet,
> > "''") & "'"
> > End If
> >
> > If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> > If Me.mdStatusProjet = "Reçue" Then
> > strfiltre = strfiltre & " AND [Date reçue] is not null"
> > Else
> > strfiltre = strfiltre & " AND [Date reçue] is null"
> > End If
> > End If
> >
> > If Me.ModTerme.Column(1) <> "" And Not
> Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
> Me.ModTerme.Column(1)
> > End If
> >
> > If strfiltre <> "" Then
> > strfiltre = "WHERE " & strfiltre
> > End If
> >
> >
> > ' Changer la cible selon où est placé le fichier template
> >
> > strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
> >
> > Set db = CurrentDb()
> > Dim rstProjets As Recordset
> > Set rstProjets = db.OpenRecordset("SELECT [Projet
> & _
> > "FROM ([Projet Principal] LEFT
> > [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub
> > type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
> LEFT
> > JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & _
> > " GROUP BY [Projet
> "
> > & _
> > "ORDER BY [Projet
> Principal].Titre;")
> >
> > If rstProjets.EOF Then
> > MsgBox ("Aucun résultat disponible pour votre sélection")
> > Else
> >
> > Dim XL As New Excel.Application
> > Dim wbk As Excel.Workbook
> >
> > flgExcelOuvert = True
> >
> > XL.Visible = True
> >
> > Set wbk = XL.Workbooks.Add(strTemplate)
> > flgWbkOuvert = True
> >
> > intFeuil = 1
> > rstProjets.MoveFirst
> >
> > strSheetName = Left$(rstProjets("Titre"), 31)
> > strSheetName = Replace([strSheetName], "/", " ")
> > strSheetName = Replace([strSheetName], "*", " ")
> > strSheetName = Replace([strSheetName], "", " ")
> > strSheetName = Replace([strSheetName], "?", " ")
> > wbk.Sheets(intFeuil).name = strSheetName
> > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> >
> > rstProjets.MoveNext
> > While Not rstProjets.EOF
> > wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> > intFeuil = intFeuil + 1
> > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> >
> > strSheetName = Left$(rstProjets("Titre"), 31)
> > strSheetName = Replace([strSheetName], "/", " ")
> > strSheetName = Replace([strSheetName], "*", " ")
> > strSheetName = Replace([strSheetName], "", " ")
> > strSheetName = Replace([strSheetName], "?", " ")
> > wbk.Sheets(intFeuil).name = strSheetName
> >
> >
> > Set rstSousProjets = db.OpenRecordset("SELECT
> [Sous-projet].[No
> > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> > date].[Date butoir], [suivi date].[date reçue] " & _
> > "FROM ([Projet Principal] LEFT JOIN
> > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> pub
> > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
> > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & " AND [Projet
> > > > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> > "Order By [Sous-projet].[No S-projet
> SAV]")
> >
> > wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
> >
> > intLigne = 6
> >
> > While Not rstSousProjets.EOF
> > With wbk.Sheets(strSheetName)
> > .Range("A" & intLigne).Value = rstSousProjets("No
> > SAV")
> > .Range("B" & intLigne).Value > > rstSousProjets("DESCRIPTION")
> > .Range("C" & intLigne).Value rstSousProjets("Contact")
> > .Range("D" & intLigne).Value > > rstSousProjets("Responsable")
> > .Range("E" & intLigne).Value = rstSousProjets("Date
> Envoyé")
> > .Range("F" & intLigne).Value = rstSousProjets("Date
> Butoir")
> > .Range("G" & intLigne).Value = rstSousProjets("Date
> Reçue")
> >
> > .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> >
> > .Range("G" & intLigne).Select
> > Selection.FormatConditions.Delete
> > Selection.FormatConditions.Add type:=xlCellValue,
> > Operator:=xlGreater, Formula1:="=F" & intLigne
> >
> > With Selection.FormatConditions(1).Font
> > .Bold = True
> > .Italic = False
> > .ColorIndex = 3
> > End With
> > Selection.FormatConditions.Add type:=xlCellValue,
> > Operator:=xlLess, Formula1:="=F" & intLigne
> > With Selection.FormatConditions(2).Font
> > .Bold = True
> > .Italic = False
> > .ColorIndex = 10
> > End With
> > End With
> > rstSousProjets.MoveNext
> > intLigne = intLigne + 1
> > Wend
> >
> > rstSousProjets.Close
> > Set rstSousProjets = Nothing
> > rstProjets.MoveNext
> > Wend
> > 'pour finir, on rempli la feuille 1 qui nous servait de
> On
> > la gardait vide pour la copier.
> > rstProjets.MoveFirst
> > Set rstSousProjets = db.OpenRecordset("SELECT
> > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > Responsable, [suivi date].contact, format([suivi date].[date
> > envoyé],'yyyy-mm-dd'), format([suivi date].[Date
> > format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> > "FROM ([Projet Principal] LEFT JOIN
> [Type
> > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> pub
> > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
> > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & " AND [Projet
> > Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' "
> > "Order By [Sous-projet].[No S-projet
> SAV]")
> > wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
> > wbk.Sheets(1).Columns("B:B").WrapText = True
> > wbk.Sheets(1).Select
> > wbk.Sheets(1).Cells(1, 1).Select
> >
> > XL.Visible = True
> >
> > Set XL = Nothing
> > rstProjets.Close
> > Set rstProjets = Nothing
> > Set db = Nothing
> > Set wbk = Nothing
> >
> > End If
> >
> > DoCmd.Hourglass False
> > Exit Sub
> > GestionErreur:
> > DoCmd.Hourglass False
> > If flgWbkOuvert = True Then
> > wbk.Close False
> > Set wbk = Nothing
> > End If
> > If flgExcelOuvert = True Then
> > XL.Quit
> > Set XL = Nothing
> > End If
> > If Err.Number <> 2501 Then
> > MsgBox Err.Number & " " & Err.Description
> > Else
> > MsgBox "Il n'y a pas de données pour les paramètres
> > vbInformation
> > End If
> >
> > End Sub
> >
> >
> > merci de m'aider car ça fair des heures que je piétine.
> >
> > cordialement
> >
>
>
>
Bonsoir gilbert,
Je viens d'essayer ta suggestion et malheureusement j'ai maintenant
438 propriété ou méthode non géré par l'objet.
"Gilbert" a écrit :
> Bonjour,
>
> As-tu essayé de remplacer
> Selection.FormatConditions.Delete
> Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
> Formula1:="=F" & intLigne
> par
> Selection.FormatConditions.Modify type:=xlCellValue,
> Formula1:="=F" & intLigne
> ?
> --
> Cordialement,
>
> Gilbert
>
>
> "Gaya" a écrit dans le message de
> news:
> > Bonjour a vous tous,
> >
> > Sous access 2003, je transfers en vb des enregistrements dans un
> > excel et j'ai une forme conditonnelle a appliquer .
> > Lorsque j'exécute la première fois tout est ok mais si je réexécute
> > secondes fois, j'obtiens l'erreur 91.
> >
> > Pour régler je dois fermer la BD et repartir. encore la je pense
> > qu'une fois et la seconde fois ça ne marche pas.
> >
> > Je plante à la ligne :
> > Selection.FormatConditions.Delete
> >
> > Voici mon code :
> >
> >
> > Private Sub cmdGenerateExcelFile_Click()
> > On Error GoTo GestionErreur
> > Dim db As Database
> > Dim rstSousProjets As Recordset
> > Dim strsql As String
> > Dim strSheetName As String
> > Dim strfiltre, intColonne As String
> > Dim flgExcelOuvert As Boolean
> > Dim flgWbkOuvert As Boolean
> >
> > Dim intFeuil As Integer, strTemplate As String
> > Dim countrecord, intLigne
> >
> > DoCmd.Hourglass True
> >
> > If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> > strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''")
> "'"
> > End If
> >
> > If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> > End If
> >
> > If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet,
> > "''") & "'"
> > End If
> >
> > If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> > If Me.mdStatusProjet = "Reçue" Then
> > strfiltre = strfiltre & " AND [Date reçue] is not null"
> > Else
> > strfiltre = strfiltre & " AND [Date reçue] is null"
> > End If
> > End If
> >
> > If Me.ModTerme.Column(1) <> "" And Not
> Then
> > If strfiltre <> "" Then
> > strfiltre = strfiltre & " AND "
> > End If
> > strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
> Me.ModTerme.Column(1)
> > End If
> >
> > If strfiltre <> "" Then
> > strfiltre = "WHERE " & strfiltre
> > End If
> >
> >
> > ' Changer la cible selon où est placé le fichier template
> >
> > strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
> >
> > Set db = CurrentDb()
> > Dim rstProjets As Recordset
> > Set rstProjets = db.OpenRecordset("SELECT [Projet
> & _
> > "FROM ([Projet Principal] LEFT
> > [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub
> > type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
> LEFT
> > JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & _
> > " GROUP BY [Projet
> "
> > & _
> > "ORDER BY [Projet
> Principal].Titre;")
> >
> > If rstProjets.EOF Then
> > MsgBox ("Aucun résultat disponible pour votre sélection")
> > Else
> >
> > Dim XL As New Excel.Application
> > Dim wbk As Excel.Workbook
> >
> > flgExcelOuvert = True
> >
> > XL.Visible = True
> >
> > Set wbk = XL.Workbooks.Add(strTemplate)
> > flgWbkOuvert = True
> >
> > intFeuil = 1
> > rstProjets.MoveFirst
> >
> > strSheetName = Left$(rstProjets("Titre"), 31)
> > strSheetName = Replace([strSheetName], "/", " ")
> > strSheetName = Replace([strSheetName], "*", " ")
> > strSheetName = Replace([strSheetName], "", " ")
> > strSheetName = Replace([strSheetName], "?", " ")
> > wbk.Sheets(intFeuil).name = strSheetName
> > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> >
> > rstProjets.MoveNext
> > While Not rstProjets.EOF
> > wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> > intFeuil = intFeuil + 1
> > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> >
> > strSheetName = Left$(rstProjets("Titre"), 31)
> > strSheetName = Replace([strSheetName], "/", " ")
> > strSheetName = Replace([strSheetName], "*", " ")
> > strSheetName = Replace([strSheetName], "", " ")
> > strSheetName = Replace([strSheetName], "?", " ")
> > wbk.Sheets(intFeuil).name = strSheetName
> >
> >
> > Set rstSousProjets = db.OpenRecordset("SELECT
> [Sous-projet].[No
> > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> > date].[Date butoir], [suivi date].[date reçue] " & _
> > "FROM ([Projet Principal] LEFT JOIN
> > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> pub
> > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
> > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & " AND [Projet
> > > > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> > "Order By [Sous-projet].[No S-projet
> SAV]")
> >
> > wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
> >
> > intLigne = 6
> >
> > While Not rstSousProjets.EOF
> > With wbk.Sheets(strSheetName)
> > .Range("A" & intLigne).Value = rstSousProjets("No
> > SAV")
> > .Range("B" & intLigne).Value > > rstSousProjets("DESCRIPTION")
> > .Range("C" & intLigne).Value rstSousProjets("Contact")
> > .Range("D" & intLigne).Value > > rstSousProjets("Responsable")
> > .Range("E" & intLigne).Value = rstSousProjets("Date
> Envoyé")
> > .Range("F" & intLigne).Value = rstSousProjets("Date
> Butoir")
> > .Range("G" & intLigne).Value = rstSousProjets("Date
> Reçue")
> >
> > .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> >
> > .Range("G" & intLigne).Select
> > Selection.FormatConditions.Delete
> > Selection.FormatConditions.Add type:=xlCellValue,
> > Operator:=xlGreater, Formula1:="=F" & intLigne
> >
> > With Selection.FormatConditions(1).Font
> > .Bold = True
> > .Italic = False
> > .ColorIndex = 3
> > End With
> > Selection.FormatConditions.Add type:=xlCellValue,
> > Operator:=xlLess, Formula1:="=F" & intLigne
> > With Selection.FormatConditions(2).Font
> > .Bold = True
> > .Italic = False
> > .ColorIndex = 10
> > End With
> > End With
> > rstSousProjets.MoveNext
> > intLigne = intLigne + 1
> > Wend
> >
> > rstSousProjets.Close
> > Set rstSousProjets = Nothing
> > rstProjets.MoveNext
> > Wend
> > 'pour finir, on rempli la feuille 1 qui nous servait de
> On
> > la gardait vide pour la copier.
> > rstProjets.MoveFirst
> > Set rstSousProjets = db.OpenRecordset("SELECT
> > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > Responsable, [suivi date].contact, format([suivi date].[date
> > envoyé],'yyyy-mm-dd'), format([suivi date].[Date
> > format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> > "FROM ([Projet Principal] LEFT JOIN
> [Type
> > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
> pub
> > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
> > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> employé].[No
> > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> Projet
> > principal] = [Sous-projet].[No projet principal] " & _
> > strfiltre & " AND [Projet
> > Principal].Titre = '" & Replace(rstProjets("Titre"), "'", "''") & "' "
> > "Order By [Sous-projet].[No S-projet
> SAV]")
> > wbk.Sheets(1).Range("A6").CopyFromRecordset rstSousProjets
> > wbk.Sheets(1).Columns("B:B").WrapText = True
> > wbk.Sheets(1).Select
> > wbk.Sheets(1).Cells(1, 1).Select
> >
> > XL.Visible = True
> >
> > Set XL = Nothing
> > rstProjets.Close
> > Set rstProjets = Nothing
> > Set db = Nothing
> > Set wbk = Nothing
> >
> > End If
> >
> > DoCmd.Hourglass False
> > Exit Sub
> > GestionErreur:
> > DoCmd.Hourglass False
> > If flgWbkOuvert = True Then
> > wbk.Close False
> > Set wbk = Nothing
> > End If
> > If flgExcelOuvert = True Then
> > XL.Quit
> > Set XL = Nothing
> > End If
> > If Err.Number <> 2501 Then
> > MsgBox Err.Number & " " & Err.Description
> > Else
> > MsgBox "Il n'y a pas de données pour les paramètres
> > vbInformation
> > End If
> >
> > End Sub
> >
> >
> > merci de m'aider car ça fair des heures que je piétine.
> >
> > cordialement
> >
>
>
>
Tu dis que l'erreur se produit à la 2° exécution de la procédure. La
commande Selection.FormatConditions.Delete étant dans une boucle, as-tu
regardé à quel moment se produit l'erreur? Dès le premier passage? lors du
dernier? au milieu? Ce peut être un indice.
Il te faudrait peut-être essayer d'exécuter en pas à pas en contrôlant au
fur et à mesure ton fichier Excel.
--
Cordialement,
Gilbert
"Gaya" a écrit dans le message de
news:
> Bonsoir gilbert,
>
> Je viens d'essayer ta suggestion et malheureusement j'ai maintenant
l'erreur:
>
> 438 propriété ou méthode non géré par l'objet.
>
>
>
> "Gilbert" a écrit :
>
> > Bonjour,
> >
> > As-tu essayé de remplacer
> > Selection.FormatConditions.Delete
> > Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
> > Formula1:="=F" & intLigne
> > par
> > Selection.FormatConditions.Modify type:=xlCellValue,
Operator:=xlGreater,
> > Formula1:="=F" & intLigne
> > ?
> > --
> > Cordialement,
> >
> > Gilbert
> >
> >
> > "Gaya" a écrit dans le message de
> > news:
> > > Bonjour a vous tous,
> > >
> > > Sous access 2003, je transfers en vb des enregistrements dans un
fichier
> > > excel et j'ai une forme conditonnelle a appliquer .
> > > Lorsque j'exécute la première fois tout est ok mais si je réexécute
une
> > > secondes fois, j'obtiens l'erreur 91.
> > >
> > > Pour régler je dois fermer la BD et repartir. encore la je pense
seulement
> > > qu'une fois et la seconde fois ça ne marche pas.
> > >
> > > Je plante à la ligne :
> > > Selection.FormatConditions.Delete
> > >
> > > Voici mon code :
> > >
> > >
> > > Private Sub cmdGenerateExcelFile_Click()
> > > On Error GoTo GestionErreur
> > > Dim db As Database
> > > Dim rstSousProjets As Recordset
> > > Dim strsql As String
> > > Dim strSheetName As String
> > > Dim strfiltre, intColonne As String
> > > Dim flgExcelOuvert As Boolean
> > > Dim flgWbkOuvert As Boolean
> > >
> > > Dim intFeuil As Integer, strTemplate As String
> > > Dim countrecord, intLigne
> > >
> > > DoCmd.Hourglass True
> > >
> > > If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> > > strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''")
&
> > "'"
> > > End If
> > >
> > > If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> > > End If
> > >
> > > If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet,
"'",
> > > "''") & "'"
> > > End If
> > >
> > > If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> > > If Me.mdStatusProjet = "Reçue" Then
> > > strfiltre = strfiltre & " AND [Date reçue] is not null"
> > > Else
> > > strfiltre = strfiltre & " AND [Date reçue] is null"
> > > End If
> > > End If
> > >
> > > If Me.ModTerme.Column(1) <> "" And Not
IsNull(Me.ModTerme.Column(1))
> > Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
> > Me.ModTerme.Column(1)
> > > End If
> > >
> > > If strfiltre <> "" Then
> > > strfiltre = "WHERE " & strfiltre
> > > End If
> > >
> > >
'************************************************************************
> > > ' Changer la cible selon où est placé le fichier template
> > >
'************************************************************************
> > > strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
> > >
> > > Set db = CurrentDb()
> > > Dim rstProjets As Recordset
> > > Set rstProjets = db.OpenRecordset("SELECT [Projet
Principal].Titre "
> > & _
> > > "FROM ([Projet Principal] LEFT
JOIN
> > > [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub
tech].[No
> > > type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
> > LEFT
> > > JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _
> > > strfiltre & _
> > > " GROUP BY [Projet
Principal].Titre
> > "
> > > & _
> > > "ORDER BY [Projet
> > Principal].Titre;")
> > >
> > > If rstProjets.EOF Then
> > > MsgBox ("Aucun résultat disponible pour votre sélection")
> > > Else
> > >
> > > Dim XL As New Excel.Application
> > > Dim wbk As Excel.Workbook
> > >
> > > flgExcelOuvert = True
> > >
> > > XL.Visible = True
> > >
> > > Set wbk = XL.Workbooks.Add(strTemplate)
> > > flgWbkOuvert = True
> > >
> > > intFeuil = 1
> > > rstProjets.MoveFirst
> > >
> > > strSheetName = Left$(rstProjets("Titre"), 31)
> > > strSheetName = Replace([strSheetName], "/", " ")
> > > strSheetName = Replace([strSheetName], "*", " ")
> > > strSheetName = Replace([strSheetName], "", " ")
> > > strSheetName = Replace([strSheetName], "?", " ")
> > > wbk.Sheets(intFeuil).name = strSheetName
> > > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> > >
> > > rstProjets.MoveNext
> > > While Not rstProjets.EOF
> > > wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> > > intFeuil = intFeuil + 1
> > > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> > >
> > > strSheetName = Left$(rstProjets("Titre"), 31)
> > > strSheetName = Replace([strSheetName], "/", " ")
> > > strSheetName = Replace([strSheetName], "*", " ")
> > > strSheetName = Replace([strSheetName], "", " ")
> > > strSheetName = Replace([strSheetName], "?", " ")
> > > wbk.Sheets(intFeuil).name = strSheetName
> > >
> > >
> > > Set rstSousProjets = db.OpenRecordset("SELECT
> > [Sous-projet].[No
> > > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > > Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> > > date].[Date butoir], [suivi date].[date reçue] " & _
> > > "FROM ([Projet Principal] LEFT JOIN
[Type
> > > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type
> > pub
> > > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
JOIN
> > > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _
> > > strfiltre & " AND [Projet
Principal].Titre
> > > > > > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> > > "Order By [Sous-projet].[No S-projet
> > SAV]")
> > >
> > > wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
> > >
> > > intLigne = 6
> > >
> > > While Not rstSousProjets.EOF
> > > With wbk.Sheets(strSheetName)
> > > .Range("A" & intLigne).Value = rstSousProjets("No
S-projet
> > > SAV")
> > > .Range("B" & intLigne).Value > > > rstSousProjets("DESCRIPTION")
> > > .Range("C" & intLigne).Value > rstSousProjets("Contact")
> > > .Range("D" & intLigne).Value > > > rstSousProjets("Responsable")
> > > .Range("E" & intLigne).Value = rstSousProjets("Date
> > Envoyé")
> > > .Range("F" & intLigne).Value = rstSousProjets("Date
> > Butoir")
> > > .Range("G" & intLigne).Value = rstSousProjets("Date
> > Reçue")
> > >
> > > .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > > .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > > .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > >
> > > .Range("G" & intLigne).Select
> > > Selection.FormatConditions.Delete
> > > Selection.FormatConditions.Add type:=xlCellValue,
> > > Operator:=xlGreater, Formula1:="=F" & intLigne
> > >
> > > With Selection.FormatConditions(1).Font
> > > .Bold = True
> > > .Italic = False
> > > .ColorIndex = 3
> > > End With
> > > Selection.FormatConditions.Add type:=xlCellValue,
> > > Operator:=xlLess, Formula1:="=F" & intLigne
> > > With Selection.FormatConditions(2).Font
> > > .Bold = True
> > > .Italic = False
> > > .ColorIndex = 10
> > > End With
> > > End With
> > > rstSousProjets.MoveNext
> > > intLigne = intLigne + 1
> > > Wend
> > >
> > > rstSousProjets.Close
> > > Set rstSousProjets = Nothing
> > > rstProjets.MoveNext
> > > Wend
> > > 'pour finir, on rempli la feuille 1 qui nous servait de
template.
> > On
> > > la gardait vide pour la copier.
> > > rstProjets.MoveFirst
> > > Set rstSousProjets = db.OpenRecordset("SELECT
[Sous-projet].[No
> > > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > > Responsable, [suivi date].contact, format([suivi date].[date
> > > envoyé],'yyyy-mm-dd'), format([suivi date].[Date
butoir],'yyyy-mm-dd'),
> > > format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> > > "FROM ([Projet Principal] LEFT JOIN
> > [Type
> > > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type
> > pub
> > > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
JOIN
> > > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _
Tu dis que l'erreur se produit à la 2° exécution de la procédure. La
commande Selection.FormatConditions.Delete étant dans une boucle, as-tu
regardé à quel moment se produit l'erreur? Dès le premier passage? lors du
dernier? au milieu? Ce peut être un indice.
Il te faudrait peut-être essayer d'exécuter en pas à pas en contrôlant au
fur et à mesure ton fichier Excel.
--
Cordialement,
Gilbert
"Gaya" <Gaya@discussions.microsoft.com> a écrit dans le message de
news:E2B8E079-C513-4384-A368-033E831074EC@microsoft.com...
> Bonsoir gilbert,
>
> Je viens d'essayer ta suggestion et malheureusement j'ai maintenant
l'erreur:
>
> 438 propriété ou méthode non géré par l'objet.
>
>
>
> "Gilbert" a écrit :
>
> > Bonjour,
> >
> > As-tu essayé de remplacer
> > Selection.FormatConditions.Delete
> > Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
> > Formula1:="=F" & intLigne
> > par
> > Selection.FormatConditions.Modify type:=xlCellValue,
Operator:=xlGreater,
> > Formula1:="=F" & intLigne
> > ?
> > --
> > Cordialement,
> >
> > Gilbert
> >
> >
> > "Gaya" <Gaya@discussions.microsoft.com> a écrit dans le message de
> > news:AB4790B4-1D7B-4825-81A2-49CFF7F1C7BF@microsoft.com...
> > > Bonjour a vous tous,
> > >
> > > Sous access 2003, je transfers en vb des enregistrements dans un
fichier
> > > excel et j'ai une forme conditonnelle a appliquer .
> > > Lorsque j'exécute la première fois tout est ok mais si je réexécute
une
> > > secondes fois, j'obtiens l'erreur 91.
> > >
> > > Pour régler je dois fermer la BD et repartir. encore la je pense
seulement
> > > qu'une fois et la seconde fois ça ne marche pas.
> > >
> > > Je plante à la ligne :
> > > Selection.FormatConditions.Delete
> > >
> > > Voici mon code :
> > >
> > >
> > > Private Sub cmdGenerateExcelFile_Click()
> > > On Error GoTo GestionErreur
> > > Dim db As Database
> > > Dim rstSousProjets As Recordset
> > > Dim strsql As String
> > > Dim strSheetName As String
> > > Dim strfiltre, intColonne As String
> > > Dim flgExcelOuvert As Boolean
> > > Dim flgWbkOuvert As Boolean
> > >
> > > Dim intFeuil As Integer, strTemplate As String
> > > Dim countrecord, intLigne
> > >
> > > DoCmd.Hourglass True
> > >
> > > If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> > > strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''")
&
> > "'"
> > > End If
> > >
> > > If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> > > End If
> > >
> > > If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet,
"'",
> > > "''") & "'"
> > > End If
> > >
> > > If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> > > If Me.mdStatusProjet = "Reçue" Then
> > > strfiltre = strfiltre & " AND [Date reçue] is not null"
> > > Else
> > > strfiltre = strfiltre & " AND [Date reçue] is null"
> > > End If
> > > End If
> > >
> > > If Me.ModTerme.Column(1) <> "" And Not
IsNull(Me.ModTerme.Column(1))
> > Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
> > Me.ModTerme.Column(1)
> > > End If
> > >
> > > If strfiltre <> "" Then
> > > strfiltre = "WHERE " & strfiltre
> > > End If
> > >
> > >
'************************************************************************
> > > ' Changer la cible selon où est placé le fichier template
> > >
'************************************************************************
> > > strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
> > >
> > > Set db = CurrentDb()
> > > Dim rstProjets As Recordset
> > > Set rstProjets = db.OpenRecordset("SELECT [Projet
Principal].Titre "
> > & _
> > > "FROM ([Projet Principal] LEFT
JOIN
> > > [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub
tech].[No
> > > type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
> > LEFT
> > > JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _
> > > strfiltre & _
> > > " GROUP BY [Projet
Principal].Titre
> > "
> > > & _
> > > "ORDER BY [Projet
> > Principal].Titre;")
> > >
> > > If rstProjets.EOF Then
> > > MsgBox ("Aucun résultat disponible pour votre sélection")
> > > Else
> > >
> > > Dim XL As New Excel.Application
> > > Dim wbk As Excel.Workbook
> > >
> > > flgExcelOuvert = True
> > >
> > > XL.Visible = True
> > >
> > > Set wbk = XL.Workbooks.Add(strTemplate)
> > > flgWbkOuvert = True
> > >
> > > intFeuil = 1
> > > rstProjets.MoveFirst
> > >
> > > strSheetName = Left$(rstProjets("Titre"), 31)
> > > strSheetName = Replace([strSheetName], "/", " ")
> > > strSheetName = Replace([strSheetName], "*", " ")
> > > strSheetName = Replace([strSheetName], "", " ")
> > > strSheetName = Replace([strSheetName], "?", " ")
> > > wbk.Sheets(intFeuil).name = strSheetName
> > > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> > >
> > > rstProjets.MoveNext
> > > While Not rstProjets.EOF
> > > wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> > > intFeuil = intFeuil + 1
> > > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> > >
> > > strSheetName = Left$(rstProjets("Titre"), 31)
> > > strSheetName = Replace([strSheetName], "/", " ")
> > > strSheetName = Replace([strSheetName], "*", " ")
> > > strSheetName = Replace([strSheetName], "", " ")
> > > strSheetName = Replace([strSheetName], "?", " ")
> > > wbk.Sheets(intFeuil).name = strSheetName
> > >
> > >
> > > Set rstSousProjets = db.OpenRecordset("SELECT
> > [Sous-projet].[No
> > > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > > Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> > > date].[Date butoir], [suivi date].[date reçue] " & _
> > > "FROM ([Projet Principal] LEFT JOIN
[Type
> > > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type
> > pub
> > > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
JOIN
> > > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _
> > > strfiltre & " AND [Projet
Principal].Titre
> > > > > > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> > > "Order By [Sous-projet].[No S-projet
> > SAV]")
> > >
> > > wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
> > >
> > > intLigne = 6
> > >
> > > While Not rstSousProjets.EOF
> > > With wbk.Sheets(strSheetName)
> > > .Range("A" & intLigne).Value = rstSousProjets("No
S-projet
> > > SAV")
> > > .Range("B" & intLigne).Value > > > rstSousProjets("DESCRIPTION")
> > > .Range("C" & intLigne).Value > rstSousProjets("Contact")
> > > .Range("D" & intLigne).Value > > > rstSousProjets("Responsable")
> > > .Range("E" & intLigne).Value = rstSousProjets("Date
> > Envoyé")
> > > .Range("F" & intLigne).Value = rstSousProjets("Date
> > Butoir")
> > > .Range("G" & intLigne).Value = rstSousProjets("Date
> > Reçue")
> > >
> > > .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > > .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > > .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > >
> > > .Range("G" & intLigne).Select
> > > Selection.FormatConditions.Delete
> > > Selection.FormatConditions.Add type:=xlCellValue,
> > > Operator:=xlGreater, Formula1:="=F" & intLigne
> > >
> > > With Selection.FormatConditions(1).Font
> > > .Bold = True
> > > .Italic = False
> > > .ColorIndex = 3
> > > End With
> > > Selection.FormatConditions.Add type:=xlCellValue,
> > > Operator:=xlLess, Formula1:="=F" & intLigne
> > > With Selection.FormatConditions(2).Font
> > > .Bold = True
> > > .Italic = False
> > > .ColorIndex = 10
> > > End With
> > > End With
> > > rstSousProjets.MoveNext
> > > intLigne = intLigne + 1
> > > Wend
> > >
> > > rstSousProjets.Close
> > > Set rstSousProjets = Nothing
> > > rstProjets.MoveNext
> > > Wend
> > > 'pour finir, on rempli la feuille 1 qui nous servait de
template.
> > On
> > > la gardait vide pour la copier.
> > > rstProjets.MoveFirst
> > > Set rstSousProjets = db.OpenRecordset("SELECT
[Sous-projet].[No
> > > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > > Responsable, [suivi date].contact, format([suivi date].[date
> > > envoyé],'yyyy-mm-dd'), format([suivi date].[Date
butoir],'yyyy-mm-dd'),
> > > format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> > > "FROM ([Projet Principal] LEFT JOIN
> > [Type
> > > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type
> > pub
> > > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
JOIN
> > > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _
Tu dis que l'erreur se produit à la 2° exécution de la procédure. La
commande Selection.FormatConditions.Delete étant dans une boucle, as-tu
regardé à quel moment se produit l'erreur? Dès le premier passage? lors du
dernier? au milieu? Ce peut être un indice.
Il te faudrait peut-être essayer d'exécuter en pas à pas en contrôlant au
fur et à mesure ton fichier Excel.
--
Cordialement,
Gilbert
"Gaya" a écrit dans le message de
news:
> Bonsoir gilbert,
>
> Je viens d'essayer ta suggestion et malheureusement j'ai maintenant
l'erreur:
>
> 438 propriété ou méthode non géré par l'objet.
>
>
>
> "Gilbert" a écrit :
>
> > Bonjour,
> >
> > As-tu essayé de remplacer
> > Selection.FormatConditions.Delete
> > Selection.FormatConditions.Add type:=xlCellValue, Operator:=xlGreater,
> > Formula1:="=F" & intLigne
> > par
> > Selection.FormatConditions.Modify type:=xlCellValue,
Operator:=xlGreater,
> > Formula1:="=F" & intLigne
> > ?
> > --
> > Cordialement,
> >
> > Gilbert
> >
> >
> > "Gaya" a écrit dans le message de
> > news:
> > > Bonjour a vous tous,
> > >
> > > Sous access 2003, je transfers en vb des enregistrements dans un
fichier
> > > excel et j'ai une forme conditonnelle a appliquer .
> > > Lorsque j'exécute la première fois tout est ok mais si je réexécute
une
> > > secondes fois, j'obtiens l'erreur 91.
> > >
> > > Pour régler je dois fermer la BD et repartir. encore la je pense
seulement
> > > qu'une fois et la seconde fois ça ne marche pas.
> > >
> > > Je plante à la ligne :
> > > Selection.FormatConditions.Delete
> > >
> > > Voici mon code :
> > >
> > >
> > > Private Sub cmdGenerateExcelFile_Click()
> > > On Error GoTo GestionErreur
> > > Dim db As Database
> > > Dim rstSousProjets As Recordset
> > > Dim strsql As String
> > > Dim strSheetName As String
> > > Dim strfiltre, intColonne As String
> > > Dim flgExcelOuvert As Boolean
> > > Dim flgWbkOuvert As Boolean
> > >
> > > Dim intFeuil As Integer, strTemplate As String
> > > Dim countrecord, intLigne
> > >
> > > DoCmd.Hourglass True
> > >
> > > If Me.cboProduit <> "" And Not IsNull(Me.cboProduit) Then
> > > strfiltre = "Produit = '" & Replace(Me.cboProduit, "'", "''")
&
> > "'"
> > > End If
> > >
> > > If Me.cboAnneeModele <> "" And Not IsNull(Me.cboAnneeModele) Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "MY = " & Me.cboAnneeModele
> > > End If
> > >
> > > If Me.modProjet <> "" And Not IsNull(Me.modProjet) Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "Titre = '" & Replace(Me.modProjet,
"'",
> > > "''") & "'"
> > > End If
> > >
> > > If Not IsNull(Me.mdStatusProjet) And Me.mdStatusProjet <> "" Then
> > > If Me.mdStatusProjet = "Reçue" Then
> > > strfiltre = strfiltre & " AND [Date reçue] is not null"
> > > Else
> > > strfiltre = strfiltre & " AND [Date reçue] is null"
> > > End If
> > > End If
> > >
> > > If Me.ModTerme.Column(1) <> "" And Not
IsNull(Me.ModTerme.Column(1))
> > Then
> > > If strfiltre <> "" Then
> > > strfiltre = strfiltre & " AND "
> > > End If
> > > strfiltre = strfiltre & "[Lt(1) - CT(2)] = " &
> > Me.ModTerme.Column(1)
> > > End If
> > >
> > > If strfiltre <> "" Then
> > > strfiltre = "WHERE " & strfiltre
> > > End If
> > >
> > >
'************************************************************************
> > > ' Changer la cible selon où est placé le fichier template
> > >
'************************************************************************
> > > strTemplate = "C:ProjetsGestion de ProjetApproval.xls"
> > >
> > > Set db = CurrentDb()
> > > Dim rstProjets As Recordset
> > > Set rstProjets = db.OpenRecordset("SELECT [Projet
Principal].Titre "
> > & _
> > > "FROM ([Projet Principal] LEFT
JOIN
> > > [Type pub tech] ON [Projet Principal].FkTypePubTech = [Type pub
tech].[No
> > > type pub tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet]
> > LEFT
> > > JOIN TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON [Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _
> > > strfiltre & _
> > > " GROUP BY [Projet
Principal].Titre
> > "
> > > & _
> > > "ORDER BY [Projet
> > Principal].Titre;")
> > >
> > > If rstProjets.EOF Then
> > > MsgBox ("Aucun résultat disponible pour votre sélection")
> > > Else
> > >
> > > Dim XL As New Excel.Application
> > > Dim wbk As Excel.Workbook
> > >
> > > flgExcelOuvert = True
> > >
> > > XL.Visible = True
> > >
> > > Set wbk = XL.Workbooks.Add(strTemplate)
> > > flgWbkOuvert = True
> > >
> > > intFeuil = 1
> > > rstProjets.MoveFirst
> > >
> > > strSheetName = Left$(rstProjets("Titre"), 31)
> > > strSheetName = Replace([strSheetName], "/", " ")
> > > strSheetName = Replace([strSheetName], "*", " ")
> > > strSheetName = Replace([strSheetName], "", " ")
> > > strSheetName = Replace([strSheetName], "?", " ")
> > > wbk.Sheets(intFeuil).name = strSheetName
> > > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> > >
> > > rstProjets.MoveNext
> > > While Not rstProjets.EOF
> > > wbk.Sheets(1).Copy After:=wbk.Sheets(intFeuil)
> > > intFeuil = intFeuil + 1
> > > wbk.Sheets(intFeuil).Range("A2") = rstProjets("Titre")
> > >
> > > strSheetName = Left$(rstProjets("Titre"), 31)
> > > strSheetName = Replace([strSheetName], "/", " ")
> > > strSheetName = Replace([strSheetName], "*", " ")
> > > strSheetName = Replace([strSheetName], "", " ")
> > > strSheetName = Replace([strSheetName], "?", " ")
> > > wbk.Sheets(intFeuil).name = strSheetName
> > >
> > >
> > > Set rstSousProjets = db.OpenRecordset("SELECT
> > [Sous-projet].[No
> > > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > > Responsable, [suivi date].contact, [suivi date].[date envoyé], [suivi
> > > date].[Date butoir], [suivi date].[date reçue] " & _
> > > "FROM ([Projet Principal] LEFT JOIN
[Type
> > > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type
> > pub
> > > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
JOIN
> > > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _
> > > strfiltre & " AND [Projet
Principal].Titre
> > > > > > '" & Replace(rstProjets("Titre"), "'", "''") & "' " & _
> > > "Order By [Sous-projet].[No S-projet
> > SAV]")
> > >
> > > wbk.Sheets(strSheetName).Columns("B:B").WrapText = True
> > >
> > > intLigne = 6
> > >
> > > While Not rstSousProjets.EOF
> > > With wbk.Sheets(strSheetName)
> > > .Range("A" & intLigne).Value = rstSousProjets("No
S-projet
> > > SAV")
> > > .Range("B" & intLigne).Value > > > rstSousProjets("DESCRIPTION")
> > > .Range("C" & intLigne).Value > rstSousProjets("Contact")
> > > .Range("D" & intLigne).Value > > > rstSousProjets("Responsable")
> > > .Range("E" & intLigne).Value = rstSousProjets("Date
> > Envoyé")
> > > .Range("F" & intLigne).Value = rstSousProjets("Date
> > Butoir")
> > > .Range("G" & intLigne).Value = rstSousProjets("Date
> > Reçue")
> > >
> > > .Range("E" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > > .Range("F" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > > .Range("G" & intLigne).NumberFormat = "yyyy/mm/dd;@"
> > >
> > > .Range("G" & intLigne).Select
> > > Selection.FormatConditions.Delete
> > > Selection.FormatConditions.Add type:=xlCellValue,
> > > Operator:=xlGreater, Formula1:="=F" & intLigne
> > >
> > > With Selection.FormatConditions(1).Font
> > > .Bold = True
> > > .Italic = False
> > > .ColorIndex = 3
> > > End With
> > > Selection.FormatConditions.Add type:=xlCellValue,
> > > Operator:=xlLess, Formula1:="=F" & intLigne
> > > With Selection.FormatConditions(2).Font
> > > .Bold = True
> > > .Italic = False
> > > .ColorIndex = 10
> > > End With
> > > End With
> > > rstSousProjets.MoveNext
> > > intLigne = intLigne + 1
> > > Wend
> > >
> > > rstSousProjets.Close
> > > Set rstSousProjets = Nothing
> > > rstProjets.MoveNext
> > > Wend
> > > 'pour finir, on rempli la feuille 1 qui nous servait de
template.
> > On
> > > la gardait vide pour la copier.
> > > rstProjets.MoveFirst
> > > Set rstSousProjets = db.OpenRecordset("SELECT
[Sous-projet].[No
> > > S-projet SAV], [Sous-projet].Description, ([prenom] & ' ' & [nom]) AS
> > > Responsable, [suivi date].contact, format([suivi date].[date
> > > envoyé],'yyyy-mm-dd'), format([suivi date].[Date
butoir],'yyyy-mm-dd'),
> > > format([suivi date].[date reçue],'yyyy-mm-dd') " & _
> > > "FROM ([Projet Principal] LEFT JOIN
> > [Type
> > > pub tech] ON [Projet Principal].FkTypePubTech = [Type pub tech].[No
type
> > pub
> > > tech]) INNER JOIN ([Liste employé] RIGHT JOIN (([Sous-projet] LEFT
JOIN
> > > TbSousTypesPubTech ON [Sous-projet].FkSousTypePubTech > > > > TbSousTypesPubTech.PkSousTypePubTech) LEFT JOIN [suivi date] ON
> > > [Sous-projet].[No S-projet] = [suivi date].[s-projet]) ON[Liste
> > employé].[No
> > > employé] = [Sous-projet].[Resp Rédaction]) ON [Projet Principal].[No
> > Projet
> > > principal] = [Sous-projet].[No projet principal] " & _