VBA: ouverure d'un TCD

Jessy Sempere [MVP]

24/09/2004 à 11:41

Bonjour

Il nous faudrait le code complet pour éventuellement déceler une erreur...

Sinon est-ce que tu libères bien tes variables objets à la fin de ton
code ? Genre :

set xlApp = nothing

Normalement rien ne t'empêche de lancer plusieurs instances d'Excel
à condition de bien les refermer après tu n'es donc pas obliger d'utiliser
GetObject au lieu de CreateObject

@+
Jessy Sempere - Access MVP

------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
"Stach" a écrit dans le message news:
069601c4a219$7de02460$
Bonjour à tous,

Dans ma bd j'ai un bouton dans un formulaire indépendant
qui me permet d'ouvrir un tableau croisé dynamique déjà
trié selon les critères renseignés dans mon formulaire.

Tout se passe pour le mieux si Excel n'est pas déjà
actif. En revanche si Excel était déjà actif avant
l'ouverture de ma base de donnée, le tableau s'ouvre mais
ne se trie pas automatiquement et j'obtiens un débogage
sur la fermeture de mon TCD, bref ça plante.

Pourtant dans le code d'ouverture du TCD j'ouvre une
nouvelle application Excel en faisant:

Set xlapp = CreateObject("Excel.Application")

mais à mon avis, access essaie d'apliquer le code à la
1ère application Excel ouverte.

Comment résoudre mon problème?

Merci bien.

Stach ;-)

24/09/2004 à 11:57

Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage =
Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage =
Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage =
Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage =
Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage =
Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage =
Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)" Then
myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-yy")
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

Vous avez filtré cet utilisateur ! Consultez son message

Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage =
Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage =
Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage =
Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage =
Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage =
Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage =
Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)" Then
myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-yy")
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

Jessy Sempere [MVP]

24/09/2004 à 12:07

Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu declares ta variables
en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP

------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
a écrit dans le message news:
153301c4a21c$d6f0b620$
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)" Then
myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-yy")
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu declares ta variables
en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP
news@access.fr.vu
------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
<anonymous@discussions.microsoft.com> a écrit dans le message news:
153301c4a21c$d6f0b620$a301280a@phx.gbl...
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)" Then
myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-yy")
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

Vous avez filtré cet utilisateur ! Consultez son message

Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu declares ta variables
en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP

------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
a écrit dans le message news:
153301c4a21c$d6f0b620$
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)" Then
myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-yy")
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

Stach

24/09/2004 à 12:33

En fait, n'y aurai-t-il pas moyen de faire un code qui si
une application Excel est déjà ouverte, rendre celle-ci
inactive (sans la fermer) puis d'ouvrir une 2ème
application Excel et rendre cette 2ème active pour
exécuter mon TCD?

Est-ce possible? si oui, comment?

Thanks. Stach ;-)

-----Message d'origine-----
Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu
declares ta variables

en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP

------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
a écrit dans le
message news:

153301c4a21c$d6f0b620$
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage =
Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage =
Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage =
Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage =
Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage =
Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage =
Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)"
Then

myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)"
Then

myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-
yy")

Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

.

En fait, n'y aurai-t-il pas moyen de faire un code qui si
une application Excel est déjà ouverte, rendre celle-ci
inactive (sans la fermer) puis d'ouvrir une 2ème
application Excel et rendre cette 2ème active pour
exécuter mon TCD?

Est-ce possible? si oui, comment?

Thanks. Stach ;-)

-----Message d'origine-----
Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu
declares ta variables

en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP
news@access.fr.vu
------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
<anonymous@discussions.microsoft.com> a écrit dans le
message news:

153301c4a21c$d6f0b620$a301280a@phx.gbl...
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage =
Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage =
Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage =
Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage =
Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage =
Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage =
Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)"
Then

myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)"
Then

myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-
yy")

Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

.

Vous avez filtré cet utilisateur ! Consultez son message

En fait, n'y aurai-t-il pas moyen de faire un code qui si
une application Excel est déjà ouverte, rendre celle-ci
inactive (sans la fermer) puis d'ouvrir une 2ème
application Excel et rendre cette 2ème active pour
exécuter mon TCD?

Est-ce possible? si oui, comment?

Thanks. Stach ;-)

-----Message d'origine-----
Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu
declares ta variables

en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP

------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
a écrit dans le
message news:

153301c4a21c$d6f0b620$
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage =
Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage =
Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage =
Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage =
Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage =
Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage =
Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)"
Then

myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)"
Then

myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-
yy")

Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

.

Raymond [mvp]

24/09/2004 à 13:01

Bonjour.

tu peux savoir si une appli office est chargée par une api que tu trouveras
sur : http://access.vba.free.fr/app_office_chargee.htm, mais elle ne peut
que l'activer et non la désactiver. une idée pour faire avancer.

--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Stach" a écrit dans le message de
news: 21e101c4a221$e7603940$
En fait, n'y aurai-t-il pas moyen de faire un code qui si
une application Excel est déjà ouverte, rendre celle-ci
inactive (sans la fermer) puis d'ouvrir une 2ème
application Excel et rendre cette 2ème active pour
exécuter mon TCD?

Est-ce possible? si oui, comment?

Thanks. Stach ;-)

-----Message d'origine-----
Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu
declares ta variables

en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP

------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
a écrit dans le
message news:

153301c4a21c$d6f0b620$
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage >Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage >Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage >Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage >Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage >Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage >Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)"
Then

myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)"
Then

myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-
yy")

Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

.

Bonjour.

tu peux savoir si une appli office est chargée par une api que tu trouveras
sur : http://access.vba.free.fr/app_office_chargee.htm, mais elle ne peut
que l'activer et non la désactiver. une idée pour faire avancer.

--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Stach" <anonymous@discussions.microsoft.com> a écrit dans le message de
news: 21e101c4a221$e7603940$a401280a@phx.gbl...
En fait, n'y aurai-t-il pas moyen de faire un code qui si
une application Excel est déjà ouverte, rendre celle-ci
inactive (sans la fermer) puis d'ouvrir une 2ème
application Excel et rendre cette 2ème active pour
exécuter mon TCD?

Est-ce possible? si oui, comment?

Thanks. Stach ;-)

-----Message d'origine-----
Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu
declares ta variables

en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP
news@access.fr.vu
------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
<anonymous@discussions.microsoft.com> a écrit dans le
message news:

153301c4a21c$d6f0b620$a301280a@phx.gbl...
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage >Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage >Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage >Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage >Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage >Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage >Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)"
Then

myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)"
Then

myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-
yy")

Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

.

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour.

tu peux savoir si une appli office est chargée par une api que tu trouveras
sur : http://access.vba.free.fr/app_office_chargee.htm, mais elle ne peut
que l'activer et non la désactiver. une idée pour faire avancer.

--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum

"Stach" a écrit dans le message de
news: 21e101c4a221$e7603940$
En fait, n'y aurai-t-il pas moyen de faire un code qui si
une application Excel est déjà ouverte, rendre celle-ci
inactive (sans la fermer) puis d'ouvrir une 2ème
application Excel et rendre cette 2ème active pour
exécuter mon TCD?

Est-ce possible? si oui, comment?

Thanks. Stach ;-)

-----Message d'origine-----
Re,

Je n'ai regarder ton code dans sa globalité mais bon...
En fait il ne faut pas rajouter createObject vu que tu
declares ta variables

en utilisant le mot clé New

Par contre met à la fin de ton code

set xlApp = Nothing
--
@+
Jessy Sempere - Access MVP

------------------------------------
Site @ccess : http://access.jessy.free.fr/
Pour l'efficacité de tous :
http://users.skynet.be/mpfa/
------------------------------------
a écrit dans le
message news:

153301c4a21c$d6f0b620$
Si vous pouvez faire qqch pour moi, voici mon code:

Private Sub btnINSTATSUPPSEARCH_Click()

Dim xlapp As New Excel.Application
Dim myval As String, mycount As String, line As Integer,
linelast As Integer, myline As Integer, col As Integer
Dim myheader As String, myheadertxt As String
Dim valall As String, valtotal As String

'Sélection de l'utilisateur
Select Case CurrentUser
Case "DSH":
valall = "(Alle)"
valtotal = "Gesamtzahl"
Case Else:
valall = "(tous)"
valtotal = "Total"
End Select

DoCmd.OpenForm "frmINDYNRESULT", acNormal

xlapp.Visible = True

With Forms("frmINDYNRESULT")
.PivotTable.Verb = acOLEVerbOpen
.PivotTable.Action = acOLEActivate
End With

Debug.Print ActiveWorkbook.Name & " " & xlapp.Name
xlapp.ActiveWorkbook.RefreshAll

With ActiveSheet.PivotTables("Tableau croisé dynamique1")

Rows("1:100").Select
Selection.EntireRow.Hidden = False

'Filtre date
For Each Item In .PivotFields("UNLOADING
MONTH").PivotItems
If Item.Name < Format(Me!txtDATE1.Value, "yy-mm")
Or Item.Name > Format(Me!txtDATE2.Value, "yy-mm") Then
Item.Visible = False
Else
Item.Visible = True
End If
Next

'Filtre produit
If Me!cmbPRODUCTS <> "" Then
For Each Item In .PivotFields
("PRODUCTS").PivotItems
If Item.Name <> Me.cmbPRODUCTS.Value Then
Item.Visible = False
End If
Next
Else
For Each Item In .PivotFields
("PRODUCTS").PivotItems
'Item.Visible = True
Next
End If

'Filtre compagnie
If Me!cmbCOMPANY <> "" Then
.PivotFields("COMPANY").CurrentPage >Me.cmbCOMPANY.Value
Else
.PivotFields("COMPANY").CurrentPage = valall
End If

'Filtre fournisseur
If Me!cmbSUPPLIERS <> "" Then
.PivotFields("SUPPLIER").CurrentPage >Me.cmbSUPPLIERS.Value
Else
.PivotFields("SUPPLIER").CurrentPage = valall
End If

'Filtre sous-Produit
If Me!cmbSUBPROD <> "" Then
.PivotFields("INSUBPROD").CurrentPage >Me.cmbSUBPROD.Value
Else
.PivotFields("INSUBPROD").CurrentPage = valall
End If

'Filtre type
If Me!cmbKIND <> "" Then
.PivotFields("KIND").CurrentPage = Me.cmbKIND.Value
Else
.PivotFields("KIND").CurrentPage = valall
End If

'Filtre bateau
If Me!cmbSHIP <> "" Then
.PivotFields("SHIP").CurrentPage = Me.cmbSHIP.Value
Else
.PivotFields("SHIP").CurrentPage = valall
End If

'Filtre bateau de mer
If Me!cmbSEASHIP <> "" Then
.PivotFields("SEASHIP").CurrentPage >Me.cmbSEASHIP.Value
Else
.PivotFields("SEASHIP").CurrentPage = valall
End If

'Filtre port de chargement
If Me!cmbINLOADPLACE <> "" Then
.PivotFields("LOADPLACE").CurrentPage >Me.cmbINLOADPLACE.Value
Else
.PivotFields("LOADPLACE").CurrentPage = valall
End If

'Filtre grue
If Me!cmbCRANE <> "" Then
.PivotFields("CRANE").CurrentPage = Me.cmbCRANE.Value
Else
.PivotFields("CRANE").CurrentPage = valall
End If

'Filtre camion
If Me!cmbTRUCKS <> "" Then
.PivotFields("TRUCKS").CurrentPage >Me.cmbTRUCKS.Value
Else
.PivotFields("TRUCKS").CurrentPage = valall
End If

'En-Tête
ActiveSheet.PageSetup.CenterHeader = ""
myheader = ActiveSheet.PageSetup.CenterHeader
myheadertxt = ""

If .PivotFields("COMPANY").CurrentPage <> "(All)"
Then

myheader = myheadertxt & "Société: " &
Me.cmbCOMPANY.Value & ", "
End If
If .PivotFields("SUPPLIER").CurrentPage <> "(All)"
Then
myheader = myheader & "Fournisseur: " &
Me.cmbSUPPLIERS.Value & ", "
End If
If .PivotFields("INSUBPROD").CurrentPage <> "(All)"
Then
myheader = myheader & "Sous-Produit: " &
Me.cmbSUBPROD.Value & ", "
End If
If .PivotFields("KIND").CurrentPage <> "(All)" Then
myheader = myheader & "Type: " & Me.cmbKIND.Value
& ", "
End If
If .PivotFields("SHIP").CurrentPage <> "(All)" Then
myheader = myheader & "Bateau: " & Me.cmbSHIP.Value
& ", "
End If
If .PivotFields("SEASHIP").CurrentPage <> "(All)"
Then

myheader = myheader & "Bateau de mer: " &
Me.cmbSEASHIP.Value & ", "
End If
If .PivotFields("LOADPLACE").CurrentPage <> "(All)"
Then
myheader = myheader & "Chargé à: " &
Me.cmbINLOADPLACE.Value & ", "
End If
If .PivotFields("CRANE").CurrentPage <> "(All)" Then
myheader = myheader & "Grue: " & Me.cmbCRANE.Value
& ", "
End If
If .PivotFields("TRUCKS").CurrentPage <> "(All)" Then
myheader = myheader & "Camions: " &
Me.cmbTRUCKS.Value & ", "
End If

ActiveSheet.PageSetup.CenterHeader = "Rapport mensuel
Entrées du " & Me.txtDATE1.Value & " au " &
Me.txtDATE2.Value & Chr(13) & myheader

'Mise en page
line = 1
Do Until Cells(line, 1) = "ENTREES"
line = line + 1
Loop
Rows("1:" & line - 1).Select
Selection.EntireRow.Hidden = True

Cells(1, 1).Select
Selection.ColumnWidth = 25
Range(Cells(4, 2), Cells(4, 120)).Select
Selection.ColumnWidth = 12

For i = 1 To 25
If Cells(i, 1) = "PRODUCTS" Then line = i
Next

Rows(line - 2).Clear
col = 2
Do Until Cells(line, col) = valtotal
Cells(line - 2, col) = Format(DateSerial(Left(Cells
(line, col), 2), Right(Cells(line, col), 2), 1), "mmm-
yy")

Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
col = col + 1
If col >= 120 Then Exit Do
Loop

Cells(line - 2, col) = valtotal
Cells(line - 2, col).Borders
(xlEdgeLeft).LineStyle = xlContinuous
Cells(line - 2, col).Borders(xlEdgeTop).LineStyle
= xlContinuous
Cells(line - 2, col).Borders
(xlEdgeBottom).LineStyle = xlContinuous
Cells(line - 2, col).Borders
(xlEdgeRight).LineStyle = xlContinuous
Rows(line - 2).HorizontalAlignment = xlCenter

With Cells(line - 2, 1)
.Value = "ENTREES"
.Font.ColorIndex = 55
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With

With Range(Cells(line - 2, 2), Cells(line - 2, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Rows(line - 1 & ":" & line).Select
Selection.EntireRow.Hidden = True

Cells(line, col).Select
Selection.ColumnWidth = 15

myline = line
Do Until Cells(myline, 1).Value = valtotal
linelast = myline
myline = myline + 1
Loop

With Range(Cells(myline, 1), Cells(myline, col))
.Font.ColorIndex = 55
.Interior.ColorIndex = 15
.Font.Bold = True
End With

Range(Cells(line, 1), Cells(myline, col)).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

Cells(line, 1).Select

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

End Sub

Un grand merci d'avance.

Stach ;-)

PS: J'ai déjà essayer d'appeler l'application Excel avec:

Set appxl = CreateObject("Excel.Application") et de le
libérer avec Set appxl = Nothing , mais ça me donne
exactement le même résultat.

.

Loïc

24/09/2004 à 14:33

Bonjour,

Au passage, je ne sais pas si vous l'avez placé qq part
dans votre code, mais il est nécessaire de faire un
appxl.Quit (avant le Set appxl = Nothing) si vous ne
voulez pas avoir des instances "qui traînent"...

Bonne journée

Loïc

-----Message d'origine-----
Bonjour à tous,

Dans ma bd j'ai un bouton dans un formulaire indépendant
qui me permet d'ouvrir un tableau croisé dynamique déjà
trié selon les critères renseignés dans mon formulaire.

Tout se passe pour le mieux si Excel n'est pas déjà
actif. En revanche si Excel était déjà actif avant
l'ouverture de ma base de donnée, le tableau s'ouvre mais
ne se trie pas automatiquement et j'obtiens un débogage
sur la fermeture de mon TCD, bref ça plante.

Pourtant dans le code d'ouverture du TCD j'ouvre une
nouvelle application Excel en faisant:

Set xlapp = CreateObject("Excel.Application")

mais à mon avis, access essaie d'apliquer le code à la
1ère application Excel ouverte.

Comment résoudre mon problème?

Merci bien.

Stach ;-)

.

VBA: ouverure d'un TCD

6 réponses

Veuillez sélectionner un problème