[Oulook 2010] Erreur avec une ActiveCell.Formula

**rnicolas.1987** · 03/04/2014, 09h14

Bonjour,

je travaille sur une macro Outlook qui vise a créer et manipuler un fichier Excel.

Voici mon code complet:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Function NB_DAYS(date_test As Date)
    NB_DAYS = Day(DateSerial(Year(date_test), Month(date_test) + 1, 1) - 1)
End Function
 
Public Sub Get_hours()
 
    Dim oStores As Outlook.Stores
    Dim oStore As Outlook.Store
    Dim oCategories As Outlook.Categories
    Dim oCategory As Outlook.Category
    Dim OlApp As Outlook.Application
    Dim OlMapi As Outlook.NameSpace
    Dim OlFolder As Outlook.MAPIFolder
    Dim OlItems As Outlook.Items
    Dim OlAppointment As Outlook.AppointmentItem
    Dim BeginDate, EndDate As String
    Dim objOutlookAppt As Outlook.AppointmentItem
 
    Set AppXl = CreateObject("Excel.Application")
    Set xlBook = AppXl.Workbooks.Add
    Set oSheet = xlBook.Worksheets(1)
    Set OlApp = New Outlook.Application
    Set OlMapi = OlApp.GetNamespace("MAPI")
    Set OlFolder = OlMapi.GetDefaultFolder(olFolderCalendar)
    Set OlItems = OlFolder.Items
    AppXl.Visible = True
 
    Maxday = NB_DAYS(Now)
    BeginDate = "01/" & Month(Now()) & "/" & Year(Now())
    EndDate = Maxday & "/" & Month(Now()) & "/" & Year(Now())
 
 
    OlItems.Sort "[Start]"
    OlItems.IncludeRecurrences = True
 
    Set objOutlookAppt = OlItems.Find("[Start] >= '" & BeginDate & "' and [Start] <= '" & EndDate & "'")
 
'To do: Gérer les blanks
 
 
    While TypeName(objOutlookAppt) <> "Nothing"
     If objOutlookAppt.Categories <> "" And objOutlookAppt.BusyStatus = 2 Then
 
        i = i + 1
        oSheet.Cells(i + 1, 1) = objOutlookAppt.Categories
        oSheet.Cells(i + 1, 2) = objOutlookAppt.Duration / 60 'duration in hours
 
     ElseIf objOutlookAppt.Categories = "" And objOutlookAppt.BusyStatus = 2 Then
 
      i = i + 1
        oSheet.Cells(i + 1, 1) = "No category"
        oSheet.Cells(i + 1, 2) = objOutlookAppt.Duration / 60
    End If
       Set objOutlookAppt = OlItems.FindNext
    Wend
 
' Processing Excel data
Set oSheet = xlBook.ActiveSheet
oSheet.Range("A1").Value = "Project"
oSheet.Range("B1").Value = "Time (h)"
 
oSheet.Range("C2").Activate
ActiveCell.Formula = "=COUNTA(RC[-2]:R[2000]C[-2])"
 
CountMeetings = oSheet.Range("C2")
oSheet.Range("A1:A" & CountMeetings).Select
oSheet.Range("A1:A" & CountMeetings).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=oSheet.Range("E1"), Unique:=True
 
oSheet.Range("F2").Activate
ActiveCell.Formula = "=COUNTA(RC[-1]:R[95]C[-1])"
CountifE = oSheet.Range("F2")
oSheet.Columns("F:F").EntireColumn.Hidden = True
 
For j = 2 To CountifE + 1
oSheet.Range("G" & j).Activate
ActiveCell.Formula = "=SUMIF(A2:A" & (CountMeetings + 1) & ";E" & j & ";B2:B" & (CountMeetings + 1) & ")"
'ActiveCell.FormulaR1C1 = "=SUMIF(RC[-6]:R[252]C[-8],R[-1]C[-4],R[-1]C[-7]:R[91]C[-7])"
Next j
 
' saving
 
xlBook.SaveAs ("Monthly hours follow-up")
 
'Set OlApp = Nothing
'Set objOutlookAppt = Nothing
 
 
End Sub

J'ai un problème avec la ligne

Code :

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

ActiveCell.Formula = "=SUMIF(A2:A" & (CountMeetings + 1) & ";E" & j & ";B2:B" & (CountMeetings + 1) & ")"

Qui me met une erreur 1004 Application defined or object-fedined error. Sachant que ça fonctionne si je mets des ActiveCell.FormulaR1C1, mais que comme je mets des variables dedans, le comparatif est pas pratique.
Après de longue recherches sur les forums, je comprends que ma ligne est bonne et que l'erreur doit se trouver ailleurs (pour info j'ai activé la référence Excel dans Outlook Macro).

Des idées?

Merci par avance

**Oliv-** · 03/04/2014, 09h31

SAlut,

A partir d'outlook (ou word par exemple) si tu lances Excel en automation il faut toujours faire précéder les instructions de l'objet Excel application (ou dérivé)

essaye comme cela

Code :

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

1
2
oSheet.Range("C2").Activate
oSheet.ActiveCell.Formula = "=COUNTA(RC[-2]:R[2000]C[-2])"

ou comme cela j'ai pas testé

Code :

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

1
2
oSheet.Range("C2").Activate
AppXl.ActiveCell.Formula = "=COUNTA(RC[-2]:R[2000]C[-2])"

**rnicolas.1987** · 03/04/2014, 09h36

Salut,

Merci de ta réponse rapide, mais je n'ai pas d'erreur sur la ligne que tu as proposée.

Par contre en faisant ta modif sur la ligne où j'avais une erreur, j'ai toujours une erreur, mais ce n'est plus la même:

Code :

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

oSheet.ActiveCell.Formula = "=SUMIF(A2:A" & (CountMeetings + 1) & ";E" & j & ";B2:B" & (CountMeetings + 1) & ")"

438: Object doesn't support this property or method.

Je ne suis pas sur que ce soit mieux!

**Oliv-** · 03/04/2014, 11h31

En fait c'est une erreur à la c.. il faut mettre des virgules et non des point virgules.
j'ai mis un moment avant de trouver !

sinon j'ai découvert aussi qu'il existe une fonction de conversion

Code :

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

1
2
3
4
5
6
7
    Maformule = "=SUMIF(A2:A" & (CountMeetings + 1) & ",E" & j & ",B2:B" & (CountMeetings + 1) & ")"
        ActiveCell.Formula = Maformule
 
 
'ou
 
         ActiveCell.FormulaR1C1 = AppXl.ConvertFormula(Maformule, xlA1, xlR1C1)

**rnicolas.1987** · 03/04/2014, 15h21

Super ça fonctionne (Bravo!!), je progresse, mais j'ai toujours une erreur quand j'execute le script une deuxieme fois!

Il me met une erreur 91: Object variable or With block variable not set sur la première ligne qui comporte une Formula:

Code :

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

ActiveCell.Formula = "=COUNTA(RC[-2]:R[2000]C[-2])"

Bizarre que cette erreur n'apparaisse qu'a la deuxieme fois que j'execute mon code, je pense que c'est lié à la fonction formula, mais je vois pas pourquoi ca le fait que la deuxième fois?

**Oliv-** · 04/04/2014, 10h20

SAlut,

C'est cool je devais justement faire une macro pour reporter le temps passé sur mes projets, je vais partir de ton code!

en fait tu ne peux pas faire

Code :

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

1
2
oSheet.Range("C2").Activate
Activecell.Range("C2").Formula = "=COUNTA(RC[-2]:R[2000]C[-2])"

tu peux faire

Code :

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

1
2
oSheet.Range("C2").SELECT
Activecell.Range("C2").Formula = "=COUNTA(RC[-2]:R[2000]C[-2])"

mais c'est bad d'utiliser activecell ( activesheet, activeWorkbook )tu peux vite avoir des erreurs vaut mieux pointer directement la cellule à modifier

Code :

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

1
2
' oSheet.Range("C2").Activate ' n'est pas nécessaire 
oSheet.Range("C2").Formula = "=COUNTA(RC[-2]:R[2000]C[-2])"

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Public Sub Get_hours()
 
    Dim oStores As Outlook.Stores
    Dim oStore As Outlook.Store
    Dim oCategories As Outlook.Categories
    Dim oCategory As Outlook.Category
    Dim OlApp As Outlook.Application
    Dim OlMapi As Outlook.Namespace
    Dim OlFolder As Outlook.MAPIFolder
    Dim OlItems As Outlook.Items
    Dim OlAppointment As Outlook.AppointmentItem
    Dim BeginDate, EndDate As String
    Dim objOutlookAppt As Outlook.AppointmentItem
 
    Set AppXl = CreateObject("Excel.Application")
    Set xlBook = AppXl.Workbooks.Add
    Set oSheet = xlBook.Worksheets(1)
    Set OlApp = New Outlook.Application
    Set OlMapi = OlApp.GetNamespace("MAPI")
    Set OlFolder = OlMapi.GetDefaultFolder(olFolderCalendar)
    Set OlItems = OlFolder.Items
    AppXl.Visible = True
 
    Maxday = NB_DAYS(Now)
    BeginDate = "01/" & Month(Now()) & "/" & Year(Now())
    EndDate = Maxday & "/" & Month(Now()) & "/" & Year(Now())
 
 
    OlItems.Sort "[Start]"
    OlItems.IncludeRecurrences = True
 
    Set objOutlookAppt = OlItems.Find("[Start] >= '" & BeginDate & "' and [Start] <= '" & EndDate & "'")
 
'To do: Gérer les blanks
 
 
    While TypeName(objOutlookAppt) <> "Nothing"
     If objOutlookAppt.Categories <> "" And objOutlookAppt.BusyStatus = 2 Then
 
        i = i + 1
        oSheet.Cells(i + 1, 1) = objOutlookAppt.Categories
        oSheet.Cells(i + 1, 2) = objOutlookAppt.Duration / 60 'duration in hours
 
     ElseIf objOutlookAppt.Categories = "" And objOutlookAppt.BusyStatus = 2 Then
 
      i = i + 1
        oSheet.Cells(i + 1, 1) = "No category"
        oSheet.Cells(i + 1, 2) = objOutlookAppt.Duration / 60
    End If
       Set objOutlookAppt = OlItems.FindNext
    Wend
 
' Processing Excel data
Set oSheet = xlBook.ActiveSheet
oSheet.Range("A1").Value = "Project"
oSheet.Range("B1").Value = "Time (h)"
 
oSheet.Range("C2").Activate
oSheet.Range("C2").Formula = "=COUNTA(RC[-2]:R[2000]C[-2])"
 
CountMeetings = oSheet.Range("C2")
oSheet.Range("A1:A" & CountMeetings).Select
oSheet.Range("A1:A" & CountMeetings).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=oSheet.Range("E1"), Unique:=True
 
oSheet.Range("F2").Activate
oSheet.Range("F2").Formula = "=COUNTA(RC[-1]:R[95]C[-1])"
CountifE = oSheet.Range("F2")
oSheet.Columns("F:F").EntireColumn.Hidden = True
 
For j = 2 To CountifE + 1
oSheet.Range("G" & j).Activate
oSheet.Range("G" & j).Formula = "=SUMIF(A2:A" & (CountMeetings + 1) & ",E" & j & ",B2:B" & (CountMeetings + 1) & ")"
'ActiveCell.FormulaR1C1 = "=SUMIF(RC[-6]:R[252]C[-8],R[-1]C[-4],R[-1]C[-7]:R[91]C[-7])"
Next j
 
' saving
 
xlBook.SaveAs ("Monthly hours follow-up")
 
'Set OlApp = Nothing
'Set objOutlookAppt = Nothing
 
 
End Sub

[Oulook 2010] Erreur avec une ActiveCell.Formula

VBA Outlook

Vue hybride

Discussions similaires

Partager

Partager