Xtian_Québec
XLDnaute Occasionnel
Bonjour (chez vous il faut dire Bonsoir à cette heure de la journée) le Forum, en passant un gros merci à tous, c'est formidable de profiter de l'expertise de tous et chacun sur le Forum...un GROS BRAVO à tous !!! Mon seul regret c'est qu'à l'heure que je post, il se fait tard chez vous et je dois quelquefois patienter plus longtemps avant de vous lire...pas grave, mieux vaut tard que jamais comme on dit...
Voici mon pb:
J'ai un fichier actif qui s'ouvre en mode plein écran (aucune barre de commande EXCEL visible) (voir Sub PleinEcran ci-dessous) et à partir d'un autre code (voir Function GetFolderOpenLevel_1 ci-dessous), je permet aux utilisateurs du fichier de consulter des fichiers xls, doc, ou ppt. Mon pb se situe au niveau de l'affichage des menus par défaut dans ces autres fichiers. Pour ".doc" et ".ppt", aucun problème car ces applications ne considèrent pas mon code PleinÉcran et les menus de ces applications sont affichés. Par contre, quand l'utilisateur ouvre un fichier xls, le mode plein ecran est en fonction et les utilisateurs n'ont pas accès au menu par défaut dans EXCEL.
Ce que je fais, si le fichier ouvert est un fichier EXCEL, je lance mon code ÉcranNormal ce qui affiche les menus lors de l'ouverture de l'autre fichier. Ce que je n'aime pas, c'est que lorsque l'utilisateur ferme le fichier secondaire EXCEL, mon fichier actif est en mode ÉcranNormal et je voudrais que le code PleinÉcran s'exécute automatiquement à la fermeture du fichier secondaire afin de rétablir le PleinÉcran dans mon fichier actif.
Voici les codes:
Sub PleinEcran()
Dim Cbar As CommandBar
Application.ScreenUpdating = False
Application.CommandBars(1).Enabled = False
For Each Cbar In Application.CommandBars
Cbar.Enabled = False
Next Cbar
Application.DisplayFullScreen = True
With ActiveWindow
.DisplayWorkbookTabs = False
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = True
End With
[J2].Select
End Sub
Sub EcranNormal()
Dim Cbar As CommandBar
Application.ScreenUpdating = False
Application.CommandBars(1).Enabled = True
For Each Cbar In Application.CommandBars
Cbar.Enabled = True
Next Cbar
Application.DisplayFullScreen = False
With ActiveWindow
.DisplayWorkbookTabs = True
.DisplayHeadings = True
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
End With
[J2].Select
End Sub
Function GetFolderLevel_1(MyFolder, MySubFolder As String)
srvr = ThisWorkbook.Path
fld = ThisWorkbook.Path & "\" & MyFolder & "\" & MySubFolder
ChDrive srvr
ChDir fld
Dim FileToOpen As Variant
FileToOpen = Application.GetOpenFilename("Tous les fichiers(*.*),*.*", 1, "Please select the file to open", , False)
ExtensionFile = Right(FileToOpen, 3)
'Code qui ouvre un fichier EXCEL
If ExtensionFile = "xls" Then
Application.ScreenUpdating = False
Call EcranNormal
Workbooks.Open FileToOpen
Else 'on regarde pour l'extension PPT
'Code qui ouvre un fichier POWERPOINT
If ExtensionFile = "ppt" Then
Dim PPapp As PowerPoint.Application
Dim PPpre As PowerPoint.Presentation
Set PPapp = CreateObject("Powerpoint.Application")
With PPapp
.Visible = True
.Activate
End With
PPapp.Presentations.Open Filename:=FileToOpen
Set PPpre = PPapp.Presentations.Item(1)
Else 'on regarde pour l'extension DOC
'Code qui ouvre un fichier WORD
If ExtensionFile = "doc" Then
Dim WdApp As Word.Application
Dim WdDoc As Word.Document
Set WdApp = CreateObject("Word.Application")
Set WdApp = Word.Application
With WdApp
.Visible = True
.Activate
End With
Set WdDoc = WdApp.Documents.Open(FileToOpen)
Else
Msg = MsgBox("This file extension is not recorded in the code." _
& Chr(10) & "Please contact the administrator of TRAP" _
& Chr(10) & "or go directly on G Drive to open the file " _
& Chr(10) _
& Chr(10) _
& "Thank you", vbOKOnly, "AUTOMATED OPEN FUNCTIONS")
End If 'On sort du IF WORD
End If 'On sort du IF PPT
End If 'on sort du IF EXCEL
End Function
Sub F_AssessingCurrentData()
Call GetFolderLevel_1("1.-Data Acquisition", "1.1 - Assessing Current Data (AXS)")
End Sub
Quelqu'un a une idée brillante (comme toujours) ???
Merci
Xtian_Québec
Voici mon pb:
J'ai un fichier actif qui s'ouvre en mode plein écran (aucune barre de commande EXCEL visible) (voir Sub PleinEcran ci-dessous) et à partir d'un autre code (voir Function GetFolderOpenLevel_1 ci-dessous), je permet aux utilisateurs du fichier de consulter des fichiers xls, doc, ou ppt. Mon pb se situe au niveau de l'affichage des menus par défaut dans ces autres fichiers. Pour ".doc" et ".ppt", aucun problème car ces applications ne considèrent pas mon code PleinÉcran et les menus de ces applications sont affichés. Par contre, quand l'utilisateur ouvre un fichier xls, le mode plein ecran est en fonction et les utilisateurs n'ont pas accès au menu par défaut dans EXCEL.
Ce que je fais, si le fichier ouvert est un fichier EXCEL, je lance mon code ÉcranNormal ce qui affiche les menus lors de l'ouverture de l'autre fichier. Ce que je n'aime pas, c'est que lorsque l'utilisateur ferme le fichier secondaire EXCEL, mon fichier actif est en mode ÉcranNormal et je voudrais que le code PleinÉcran s'exécute automatiquement à la fermeture du fichier secondaire afin de rétablir le PleinÉcran dans mon fichier actif.
Voici les codes:
Sub PleinEcran()
Dim Cbar As CommandBar
Application.ScreenUpdating = False
Application.CommandBars(1).Enabled = False
For Each Cbar In Application.CommandBars
Cbar.Enabled = False
Next Cbar
Application.DisplayFullScreen = True
With ActiveWindow
.DisplayWorkbookTabs = False
.DisplayHeadings = False
.DisplayHorizontalScrollBar = False
.DisplayVerticalScrollBar = True
End With
[J2].Select
End Sub
Sub EcranNormal()
Dim Cbar As CommandBar
Application.ScreenUpdating = False
Application.CommandBars(1).Enabled = True
For Each Cbar In Application.CommandBars
Cbar.Enabled = True
Next Cbar
Application.DisplayFullScreen = False
With ActiveWindow
.DisplayWorkbookTabs = True
.DisplayHeadings = True
.DisplayHorizontalScrollBar = True
.DisplayVerticalScrollBar = True
End With
[J2].Select
End Sub
Function GetFolderLevel_1(MyFolder, MySubFolder As String)
srvr = ThisWorkbook.Path
fld = ThisWorkbook.Path & "\" & MyFolder & "\" & MySubFolder
ChDrive srvr
ChDir fld
Dim FileToOpen As Variant
FileToOpen = Application.GetOpenFilename("Tous les fichiers(*.*),*.*", 1, "Please select the file to open", , False)
ExtensionFile = Right(FileToOpen, 3)
'Code qui ouvre un fichier EXCEL
If ExtensionFile = "xls" Then
Application.ScreenUpdating = False
Call EcranNormal
Workbooks.Open FileToOpen
Else 'on regarde pour l'extension PPT
'Code qui ouvre un fichier POWERPOINT
If ExtensionFile = "ppt" Then
Dim PPapp As PowerPoint.Application
Dim PPpre As PowerPoint.Presentation
Set PPapp = CreateObject("Powerpoint.Application")
With PPapp
.Visible = True
.Activate
End With
PPapp.Presentations.Open Filename:=FileToOpen
Set PPpre = PPapp.Presentations.Item(1)
Else 'on regarde pour l'extension DOC
'Code qui ouvre un fichier WORD
If ExtensionFile = "doc" Then
Dim WdApp As Word.Application
Dim WdDoc As Word.Document
Set WdApp = CreateObject("Word.Application")
Set WdApp = Word.Application
With WdApp
.Visible = True
.Activate
End With
Set WdDoc = WdApp.Documents.Open(FileToOpen)
Else
Msg = MsgBox("This file extension is not recorded in the code." _
& Chr(10) & "Please contact the administrator of TRAP" _
& Chr(10) & "or go directly on G Drive to open the file " _
& Chr(10) _
& Chr(10) _
& "Thank you", vbOKOnly, "AUTOMATED OPEN FUNCTIONS")
End If 'On sort du IF WORD
End If 'On sort du IF PPT
End If 'on sort du IF EXCEL
End Function
Sub F_AssessingCurrentData()
Call GetFolderLevel_1("1.-Data Acquisition", "1.1 - Assessing Current Data (AXS)")
End Sub
Quelqu'un a une idée brillante (comme toujours) ???
Merci
Xtian_Québec
