Discussion :

[jedupl]

Bonjour,

J'ai fait de mon mieux pour developper par moi meme mais je viens d'atteindre mes limites.

Je m'explique j'ai un premier fichier ou beaucoup de choses se passent sans encombre.

je souhaite pouvoir creer un classeur different pour en faire un rapport par mois avec une feuille par jour du mois.

le code suivant me permet de creer mon fichier :

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
Sub createreport()
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
 
    'On créer l'objet Excel
    Set xlApp = CreateObject("Excel.Application")
    'On défini le nombre d'onglets (ici 5)
    xlApp.SheetsInNewWorkbook = 1
    'On ajoute un classeur
    Set xlBook = xlApp.Workbooks.Add
    'On donne un nom au classeur
    On Error Resume Next
        xlBook.SaveAs ThisWorkbook.Path & "\" & ("Report Manual request" & " " & Format(Now, "mmm-yyyy") & ".xls")
        Range("J4").Value = ThisWorkbook.Path & "\" & ("Report Manual request" & " " & Format(Now, "mmm-yyyy") & ".xls")
    On Error GoTo 0
    'On rend le classeur visible
    xlApp.Visible = True
    'On créer l'objet onglet dans le nouveau classeur créé
    Set xlSheet = xlBook.Worksheets(1)
    'On affecte un nom aux l'onglets
    xlSheet.Name = Format(Now, "dd")
    'on copie les donnees
    'dataexport()
    'On ferme l'application
    xlApp.Quit
 
End Sub

ensuite je tente de reouvrir ce tableau en cas d'ajout de donnees au rapport et je test si le jour existe. sinon j'ajoute une feuille. Et la c'est le drame :

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
Sub addtoreport()
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim dataholderwb As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim dataholderws As Excel.Worksheet
 
    Set dataholderwb = ThisWorkbook
    Set dataholderws = Sheets("b.U fill up")
    Debug.Print dataholderwb.FullName
    'Debug.Print dataholderws.FullName
 
 
 
    If Range("J4").Value <> "" Then
          Set X1book = Workbooks.Open(Range("J4").Value)
          Debug.Print X1book.FullName
          If CheckSheet(Format(Now, "dd")) Then
          'sheet already exist
               Set xlSheet = X1book.Worksheets(Sheets.Count).Activate
               Debug.Print X1book.FullName
               Debug.Print X1sheet.FullName
 
               'selection de la feuille
               'ajouter enregistrements
          Else
          'sheet doesn't exist
            X1book.Sheets.Add After:=Sheets(ThisWorkbook.Sheets.Count)
            Set xlSheet = Sheets(ThisWorkbook.Sheets.Count)
            xlSheet.Name = Format(Now, "dd")
 
               Debug.Print X1book.FullName
               Debug.Print X1sheet.FullName
 
          End If
          'copier les donnees
    Else
            MsgBox "No existing report"
    End If
 
 
 
End Sub
Function CheckSheet(ByVal sSheetName As String) As Boolean
 
    Dim oSheet As Excel.Worksheet
    Dim bReturn As Boolean
 
    For Each oSheet In ActiveWorkbook.Sheets
 
        If oSheet.Name = sSheetName Then
 
            bReturn = True
            Exit For
 
        End If
 
    Next oSheet
 
    CheckSheet = bReturn
 
End Function

ca plante a :

Code :

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

 X1book.Sheets.Add After:=Sheets(ThisWorkbook.Sheets.Count)

si ma feuille n'existe pas

ou a :

Code :

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

Set xlSheet = X1book.Worksheets(Sheets.Count).Activate

si ma feuille existe.

help please

[jedupl]

avec le code add report ce sera peut etre plus simple.

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
Sub addtoreport()
 
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim dataholderwb As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim dataholderws As Excel.Worksheet
 
    Set dataholderwb = ThisWorkbook
    Set dataholderws = Sheets("b.U fill up")
    Debug.Print dataholderwb.FullName
    'Debug.Print dataholderws.FullName
 
 
 
    If Range("J4").Value <> "" Then
          Set X1book = Workbooks.Open(Range("J4").Value)
          Debug.Print X1book.FullName
          If CheckSheet(Format(Now, "dd")) Then
          'sheet already exist
               Set xlSheet = X1book.Worksheets(Sheets.Count).Activate
               Debug.Print X1book.FullName
               Debug.Print X1sheet.FullName
 
               'selection de la feuille
               'ajouter enregistrements
          Else
          'sheet doesn't exist
            X1book.Sheets.Add After:=Sheets(ThisWorkbook.Sheets.Count)
            Set xlSheet = Sheets(ThisWorkbook.Sheets.Count)
            xlSheet.Name = Format(Now, "dd")
 
               Debug.Print X1book.FullName
               Debug.Print X1sheet.FullName
 
          End If
          'copier les donnees
    Else
            MsgBox "No existing report"
    End If
 
 
 
End Sub
Function CheckSheet(ByVal sSheetName As String) As Boolean
 
    Dim oSheet As Excel.Worksheet
    Dim bReturn As Boolean
 
    For Each oSheet In ActiveWorkbook.Sheets
 
        If oSheet.Name = sSheetName Then
 
            bReturn = True
            Exit For
 
        End If
 
    Next oSheet
 
    CheckSheet = bReturn
 
End Function

[joe.levrai]

Sans aller plus loin dans ton code, je note que tu as deux variables différentes pour ton classeur :

- X1book non déclaré, et qui est sur les lignes que tu indiques en erreur
- xlBook déclaré, et qui est instancié sur ton objet classeur

[jedupl]

je suis super stupide. Je controle ca et revient vers le forum asap.