EXCEL 97 ou EXCEL 2000

MichDenis

09/04/2005 à 23:49

Bonjour,

Dans le ThisWorkbook de ton classeur, tu ajoutes ceci en adaptant le nom de la feuille :

Pour que cela fonctionne bien, ton "plan" doit être déjà présent sur la feuille "Feul1" avant que cette procédure s'exécute à
l'ouverture du fichier.

'---------------------------------
Private Sub Workbook_Open()

With Worksheets("Feuil1")
.EnableOutlining = True
.Protect , True, True, True, True
End With

End Sub
'---------------------------------

Salutations!

"Option "Grouper et créer un plan"" <Option "Grouper et créer un plan"@discussions.microsoft.com> a écrit dans le message de news:

Comment peut-on utiliser l'option "Grouper/Dissocier et créer un plan" dans
une feuille protégée ?

Existe-t-il une macro "miracle" pour solutionner le problème ?

Merci pour votre expertise

Salutations

ChrisV

09/04/2005 à 23:57

Bonjour,

Dans la feuille de code de ThisWorkbook
(en supposant que le plan se situe en Feuil1)

Private Sub Workbook_Open()
With Worksheets("Feuil1")
.EnableOutlining = True
.Protect Password:="zaza", Contents:=True, _
UserInterfaceOnly:=True
End With
End Sub

ChrisV

"Option "Grouper et créer un plan"" <Option "Grouper et créer un
plan"@discussions.microsoft.com> a écrit dans le message de news:

J

10/04/2005 à 04:02

Bonjour
je ne suis pas expert, mais d'autres le sont, le code suivant devrait
t'aider
Bon courage
J@@

'Benoît Marchand, mpfe
' "Il est possible d'utiliser un filtre ou d'afficher/masquer un plan,
'si le filtre et le plan sont créés avant la protection de la feuille,
'protection qui sera faite par la macro suivante, qui permet également
'd'agir sur une feuille modifiée par macro sans déprotéger
'celle-ci (UserInterfaceOnly:=True)"

Sub Verrcls()
With ActiveSheet
.Protect UserInterfaceOnly:=True
.EnableAutoFilter = True
.EnableOutlining = True
End With
End Sub

"Option "Grouper et créer un plan"" <

pierre57

10/04/2005 à 18:05

Bonjour,
Merci à ChrisV et MichDenis pour la solution.
Mais un problème n'arrive jamais seul :
Le fichier Master (dans lequel j'ai intégré la routine dans "ThisWorkbook"),
génére un fichier xls contenant une feuille du Master (par copy).
Comment peut-on copier le "ThisWorkbook" du Master dans le nouveau fichier
afin d'avoir la même faculté d'utilisation de la fonction "Grouper /
Dissocier".

Merci encore pour votre expertise, je ne suis qu'un débutant acharné, mais
des fois je craque....

Ci-après les extracts des routines :

Extract Macro dans "ThisWorkbook"
Dim nombre As Integer
nombre = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
For i = 1 To nombre
Worksheets(i).Protect Password:="xxx", Contents:=True, _
UserInterfaceOnly:=True
Worksheets(i).EnableOutlining = True
Worksheets(i).EnableAutoFilter = True
Next i

Extract de la Routine de création fichier
Public Sub CreateTbaBookFile(SheetName As String, Optional ReturnErrors As
Boolean = False)
'---------------------------------------------------
' Création du carnet (fichier physique)
' par recopie de la feuille correspondante du MASTER
'---------------------------------------------------
Dim oWs2Copy As Excel.Worksheet
Dim oWsBook As Excel.Worksheet
Dim oWbTarget As Excel.Workbook
Dim oWs2Delete As Excel.Worksheet
Dim oBook As cBook
Dim lngErrNum As Long
Dim oShpBtn As Shape
Dim intBtn As Integer

On Error GoTo AbortProcess

'- 1 trouver la feuille à copier
Set oWs2Copy = ThisWorkbook.Worksheets(SheetName)

'-- Visuel
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.StatusBar = "Création du carnet " & SheetName & " -
Initialisation de la feuille"

'- 2 extraire la feuille dans un nouveau classeur
Set oWbTarget = Workbooks.Add

'- 2.2 trouver les paramètres du carnet dans colBooks
Set oBook = colBooks(SheetName)

'- 2.3 copie de la feuille
oWs2Copy.Copy Before:=oWbTarget.Sheets(1)
Set oWsBook = oWbTarget.Sheets(SheetName)
oWsBook.Visible = True

'- 2.4 suppression des feuilles inutiles
For Each oWs2Delete In oWbTarget.Worksheets
If oWs2Delete.Name <> SheetName Then oWs2Delete.Delete
Next

'- 2.5 suppression des boutons inutiles sur le carnet exporté
For intBtn = oWsBook.Shapes.Count To 1 Step -1
Set oShpBtn = oWsBook.Shapes(intBtn)
If oShpBtn.Type = msoFormControl Then
If oShpBtn.FormControlType = xlButtonControl Then
oShpBtn.Delete
End If
End If
Next

'-- Visuel
Application.StatusBar = "Création du carnet " & SheetName & " -
Enregistrement du fichier " & oBook.FileTitle

'- 2.6 Enregistrement du classeur sous le nom qui va bien
'- 2.6.1 Test du répertoire
If Not IsGoodFolder(oBook.FilePath) Then
MkDir oBook.FilePath
End If
'- 2.6.2 enregistrement du carnet
oWbTarget.SaveAs oBook.FileName
oWbTarget.Close

EndProcess:
'-- Visuel
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.StatusBar = ""
Exit Sub

AbortProcess:
lngErrNum = Err.Number
If ReturnErrors Then
'-- Renvoyer l'erreur à l'appelant
Err.Raise lngErrNum
Else
'-- Afficher directement l'erreur
MsgBox SheetName & " : " & msgGenericAbortError & Err.Description &
" (" & Err.Number & ")", vbCritical, msgCreateTbaEnv_Title
End If
Resume EndProcess

End Sub

Cordialement,

Bonjour,
Merci à ChrisV et MichDenis pour la solution.
Mais un problème n'arrive jamais seul :
Le fichier Master (dans lequel j'ai intégré la routine dans "ThisWorkbook"),
génére un fichier xls contenant une feuille du Master (par copy).
Comment peut-on copier le "ThisWorkbook" du Master dans le nouveau fichier
afin d'avoir la même faculté d'utilisation de la fonction "Grouper /
Dissocier".

Merci encore pour votre expertise, je ne suis qu'un débutant acharné, mais
des fois je craque....

Ci-après les extracts des routines :

Extract Macro dans "ThisWorkbook"
Dim nombre As Integer
nombre = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
For i = 1 To nombre
Worksheets(i).Protect Password:="xxx", Contents:=True, _
UserInterfaceOnly:=True
Worksheets(i).EnableOutlining = True
Worksheets(i).EnableAutoFilter = True
Next i

Extract de la Routine de création fichier
Public Sub CreateTbaBookFile(SheetName As String, Optional ReturnErrors As
Boolean = False)
'---------------------------------------------------
' Création du carnet (fichier physique)
' par recopie de la feuille correspondante du MASTER
'---------------------------------------------------
Dim oWs2Copy As Excel.Worksheet
Dim oWsBook As Excel.Worksheet
Dim oWbTarget As Excel.Workbook
Dim oWs2Delete As Excel.Worksheet
Dim oBook As cBook
Dim lngErrNum As Long
Dim oShpBtn As Shape
Dim intBtn As Integer

On Error GoTo AbortProcess

'- 1 trouver la feuille à copier
Set oWs2Copy = ThisWorkbook.Worksheets(SheetName)

'-- Visuel
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.StatusBar = "Création du carnet " & SheetName & " -
Initialisation de la feuille"

'- 2 extraire la feuille dans un nouveau classeur
Set oWbTarget = Workbooks.Add

'- 2.2 trouver les paramètres du carnet dans colBooks
Set oBook = colBooks(SheetName)

'- 2.3 copie de la feuille
oWs2Copy.Copy Before:=oWbTarget.Sheets(1)
Set oWsBook = oWbTarget.Sheets(SheetName)
oWsBook.Visible = True

'- 2.4 suppression des feuilles inutiles
For Each oWs2Delete In oWbTarget.Worksheets
If oWs2Delete.Name <> SheetName Then oWs2Delete.Delete
Next

'- 2.5 suppression des boutons inutiles sur le carnet exporté
For intBtn = oWsBook.Shapes.Count To 1 Step -1
Set oShpBtn = oWsBook.Shapes(intBtn)
If oShpBtn.Type = msoFormControl Then
If oShpBtn.FormControlType = xlButtonControl Then
oShpBtn.Delete
End If
End If
Next

'-- Visuel
Application.StatusBar = "Création du carnet " & SheetName & " -
Enregistrement du fichier " & oBook.FileTitle

'- 2.6 Enregistrement du classeur sous le nom qui va bien
'- 2.6.1 Test du répertoire
If Not IsGoodFolder(oBook.FilePath) Then
MkDir oBook.FilePath
End If
'- 2.6.2 enregistrement du carnet
oWbTarget.SaveAs oBook.FileName
oWbTarget.Close

EndProcess:
'-- Visuel
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.StatusBar = ""
Exit Sub

AbortProcess:
lngErrNum = Err.Number
If ReturnErrors Then
'-- Renvoyer l'erreur à l'appelant
Err.Raise lngErrNum
Else
'-- Afficher directement l'erreur
MsgBox SheetName & " : " & msgGenericAbortError & Err.Description &
" (" & Err.Number & ")", vbCritical, msgCreateTbaEnv_Title
End If
Resume EndProcess

End Sub

Cordialement,

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour,
Merci à ChrisV et MichDenis pour la solution.
Mais un problème n'arrive jamais seul :
Le fichier Master (dans lequel j'ai intégré la routine dans "ThisWorkbook"),
génére un fichier xls contenant une feuille du Master (par copy).
Comment peut-on copier le "ThisWorkbook" du Master dans le nouveau fichier
afin d'avoir la même faculté d'utilisation de la fonction "Grouper /
Dissocier".

Merci encore pour votre expertise, je ne suis qu'un débutant acharné, mais
des fois je craque....

Ci-après les extracts des routines :

Extract Macro dans "ThisWorkbook"
Dim nombre As Integer
nombre = ActiveWorkbook.Sheets.Count
Application.ScreenUpdating = False
For i = 1 To nombre
Worksheets(i).Protect Password:="xxx", Contents:=True, _
UserInterfaceOnly:=True
Worksheets(i).EnableOutlining = True
Worksheets(i).EnableAutoFilter = True
Next i

Extract de la Routine de création fichier
Public Sub CreateTbaBookFile(SheetName As String, Optional ReturnErrors As
Boolean = False)
'---------------------------------------------------
' Création du carnet (fichier physique)
' par recopie de la feuille correspondante du MASTER
'---------------------------------------------------
Dim oWs2Copy As Excel.Worksheet
Dim oWsBook As Excel.Worksheet
Dim oWbTarget As Excel.Workbook
Dim oWs2Delete As Excel.Worksheet
Dim oBook As cBook
Dim lngErrNum As Long
Dim oShpBtn As Shape
Dim intBtn As Integer

On Error GoTo AbortProcess

'- 1 trouver la feuille à copier
Set oWs2Copy = ThisWorkbook.Worksheets(SheetName)

'-- Visuel
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.StatusBar = "Création du carnet " & SheetName & " -
Initialisation de la feuille"

'- 2 extraire la feuille dans un nouveau classeur
Set oWbTarget = Workbooks.Add

'- 2.2 trouver les paramètres du carnet dans colBooks
Set oBook = colBooks(SheetName)

'- 2.3 copie de la feuille
oWs2Copy.Copy Before:=oWbTarget.Sheets(1)
Set oWsBook = oWbTarget.Sheets(SheetName)
oWsBook.Visible = True

'- 2.4 suppression des feuilles inutiles
For Each oWs2Delete In oWbTarget.Worksheets
If oWs2Delete.Name <> SheetName Then oWs2Delete.Delete
Next

'- 2.5 suppression des boutons inutiles sur le carnet exporté
For intBtn = oWsBook.Shapes.Count To 1 Step -1
Set oShpBtn = oWsBook.Shapes(intBtn)
If oShpBtn.Type = msoFormControl Then
If oShpBtn.FormControlType = xlButtonControl Then
oShpBtn.Delete
End If
End If
Next

'-- Visuel
Application.StatusBar = "Création du carnet " & SheetName & " -
Enregistrement du fichier " & oBook.FileTitle

'- 2.6 Enregistrement du classeur sous le nom qui va bien
'- 2.6.1 Test du répertoire
If Not IsGoodFolder(oBook.FilePath) Then
MkDir oBook.FilePath
End If
'- 2.6.2 enregistrement du carnet
oWbTarget.SaveAs oBook.FileName
oWbTarget.Close

EndProcess:
'-- Visuel
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.StatusBar = ""
Exit Sub

AbortProcess:
lngErrNum = Err.Number
If ReturnErrors Then
'-- Renvoyer l'erreur à l'appelant
Err.Raise lngErrNum
Else
'-- Afficher directement l'erreur
MsgBox SheetName & " : " & msgGenericAbortError & Err.Description &
" (" & Err.Number & ")", vbCritical, msgCreateTbaEnv_Title
End If
Resume EndProcess

End Sub

Cordialement,

perre57

12/04/2005 à 21:32

Vous avez filtré cet utilisateur ! Consultez son message

MichDenis

13/04/2005 à 04:51

Bonjour Pierre57,

voici comment faire pour copier la procédure (Workbook_Open) du ThisWorkbook classeur où est écrite la macro au ThisWorkbook du
classeur que l'on vient de créer.

Dans cette procédure que tu places dans un module standard, Remplace "Classeur1" par le nom du classeur que tu viens de créer.

P.S. Attention aux lignes de code qui pourraient être coupées par le service de messagerie !

'-----------------------------------
Sub CopierUneprocédure()
Dim Start As Integer, NbLignes As Integer
Dim Code As String

With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
Start = .ProcStartLine("Workbook_Open", 0)
NbLignes = .ProcCountLines("Workbook_Open", 0)
Code = .Lines(Start, NbLignes)
MsgBox Code
End With

With Workbooks("Classeur1").VBProject.VBComponents("ThisWorkbook").CodeModule
.AddFromString Code
End With

End Sub
'-----------------------------------

Salutations!

"perre57" a écrit dans le message de news:

Bonjour Pierre57,

voici comment faire pour copier la procédure (Workbook_Open) du ThisWorkbook classeur où est écrite la macro au ThisWorkbook du
classeur que l'on vient de créer.

Dans cette procédure que tu places dans un module standard, Remplace "Classeur1" par le nom du classeur que tu viens de créer.

P.S. Attention aux lignes de code qui pourraient être coupées par le service de messagerie !

'-----------------------------------
Sub CopierUneprocédure()
Dim Start As Integer, NbLignes As Integer
Dim Code As String

With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
Start = .ProcStartLine("Workbook_Open", 0)
NbLignes = .ProcCountLines("Workbook_Open", 0)
Code = .Lines(Start, NbLignes)
MsgBox Code
End With

With Workbooks("Classeur1").VBProject.VBComponents("ThisWorkbook").CodeModule
.AddFromString Code
End With

End Sub
'-----------------------------------

Salutations!

"perre57" <perre57@discussions.microsoft.com> a écrit dans le message de news: 49E95BBC-4004-469B-A16B-D3DC4FBBF07C@microsoft.com...

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour Pierre57,

voici comment faire pour copier la procédure (Workbook_Open) du ThisWorkbook classeur où est écrite la macro au ThisWorkbook du
classeur que l'on vient de créer.

Dans cette procédure que tu places dans un module standard, Remplace "Classeur1" par le nom du classeur que tu viens de créer.

P.S. Attention aux lignes de code qui pourraient être coupées par le service de messagerie !

'-----------------------------------
Sub CopierUneprocédure()
Dim Start As Integer, NbLignes As Integer
Dim Code As String

With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
Start = .ProcStartLine("Workbook_Open", 0)
NbLignes = .ProcCountLines("Workbook_Open", 0)
Code = .Lines(Start, NbLignes)
MsgBox Code
End With

With Workbooks("Classeur1").VBProject.VBComponents("ThisWorkbook").CodeModule
.AddFromString Code
End With

End Sub
'-----------------------------------

Salutations!

"perre57" a écrit dans le message de news:

EXCEL 97 ou EXCEL 2000

6 réponses

Veuillez sélectionner un problème