Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresConnexion

begin process at 2008 10 06 13:12:00

WSC 2008 : LES VIDEOS DISPONIBLES ! par phil

VISUAL STUDIO TALK SHOW: VISUAL STUDIO TEAM SYSTEM par azra

QUAND REPORTING SERVICES VIENT TAQUINER MOSS par Gribouillon

ADO.NET DATA SERVICES HOOKING POC par Matthieu MEZIL

A PROPOS DES FICHIERS "BLOQUéS" par coq

RE : RETROUVER LE HANDLE D'UNE DLL CHARGéE AVEC LOADLIBRARY par jmfmarques

RE : ADDITION ET SOUSTRACTION D'HEURES par CUTO

RE : INSERER CODE ??? par amelou2812

RE : UNE DLL NON ACTIVE NE VEUT PLUS SE DECHARGER par andrebernard

RE : INSERER CODE ??? par lillith212

+ de logiciels à télécharger

Qui Veut Gagner Des Millions ? Seconde Edition pour Windows au meilleur prix

1 256 413 membres
170 nouveaux aujourd'hui
14 396 membres club

Trouver une ressource

Trouvez une ressource parmi 38 799 codes, 1 183 557 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

GESTION DE DOCUMENTS OUVERTS DANS UNE APPLICATION

Information sur la source

Catégorie :Fichier / Disque Classé sous : commondialog, interface, utilisateur, gestion, document Niveau : Initié Date de création : 02/07/2006 Date de mise à jour : 12/07/2006 18:12:46 Vu / téléchargé: 5 422 / 754

Auteur : santiago69

Ecrire un message privé

Note :

8,00 / 10

Commentaire sur cette source (10)

Ajouter un commentaire et/ou une note

Description

Cliquez pour voir la capture en taille normale

Description _________________
! NE PAS JUGER L'APPLICATION D'EDITION DE TEXTE !
Ce module de classe vous procure une moyen simple et puissant de gerer un document ouvert dans votre application.
Peu importe que votre application affiche des fichier texte, des images, des pdf, etc... DocInApp peut gerer toute l'interface d'ouverture, enregistrement et fermeture de documents.
DocInApp gere les nouveaux documents, ceux ouverts en lecture seule, les modifications et meme l'accessibilite des bouton d'un menu fichier.

Fonctionnement ______________
La classe est basee sur le controle "Microsoft Common Dialog Control" (COMDLG32.OCX).
Creez un objet pour chaque document que vous ouvrez dans votre application.
Appelez ses methodes lors de tout evenement de creation, ouverture, modification, enregistrement et fermeture.
Ajouter votre code de manipulation de document dans les evenements de la classe.

Exemple _________________
Pour vous donner une idee des possibilites de DocInApp, regardez le contenu du formulaire principale de cet editeur de texte.
Tout est dedans, le reste est gere par DocInApp !

Source

'************************************************************************'
'************************************************************************'
'** **'
'** DOCUMENT IN APPLICATION MANAGEMENT CLASS **'
'** **'
'************************************************************************'
'************************************************************************'
'---------------------------- ATTRIBUTES ----------------------------'
'Author = Santiago Diez (santiago.diez@free.fr)
'Website = http://santiago.diez.free.fr
'Webpage = http://www.vbfrance.com/code.aspx?ID=38402
'Date = 12 JULY 2006 12:47
'Version = 2.0
'---------------------------- COPYRIGHT -----------------------------'
'I worked on that module for me and for you. You are allowed to do the
'following as long as you specify my name and website (please don't
'laught, one day it will be a real website):
'- use the code, partially or totally
'- change the code partially
'If you ever improve the features of that module, fix any bug or find any
'way to make it better, please write to me for feedback.
'--------------------------- DESCRIPTION ----------------------------'
'This class module provides you with a powerfull way to manage the files
'you open in your application.
'Each instance of objDocInApp is able to communicate with the user to
'select a file to open or to save to. It deals with read-only or modified
'documents and prompt the user for any decision to take.
'The class does not actualy open or save documents, each application has
'its own way to read or write them. Your application provide the
'procedures for reading and writing files, all the rest is provided by
'this powerfull tool.
'It's able to:
'- prompt the user to select a file to open
'- prompt the user to save changes before close, exit or open another file
'- prompt the user to select the location to save a file to (or save as)
'- force the user to save as if read-only attributes have been detected
'- display error messages if your own application was not able to create,
'open, reopen or save documents.
'--------------------------- HOW IT WORKS ---------------------------'
'The class is based on the Microsoft Common Dialog Control.
'Create an object for each file you open in your application. Call the
'class methods for the create, open, modify, save and close events and use
'the class events to code creating, opening, saving and closing files.
'-------------- PUBLIC EVENTS, PROPERTIES AND METHODS ---------------'
'Call SetDialog(CommonDialogControl As Control, [DialogOptions As
' dlgOptions])
'Call SetButtons([ArrayOfButtonsReOpen], [ArrayOfButtonsSave],
' [ArrayOfButtonsSaveAs], [ArrayOfButtonsClose],
' [ArrayOfButtonsProperties])
'Call SetLanguage([ReopenWarning], [ModifiedWarning], [ReadOnlyWarning],
' [OpenCaption], [SaveAsCaption], [ReadOnlyCaption],
' [NewError], [OpenError], [SaveError], [CloseError],
' [DocumentDefaultName], [DocumentDefaultExt],
' [DocumentDefaultFilter])
'Property Get Path() As String
'Property Get Name() As String
'Property Get Ext() As String
'Property Get ReadOnly() As String
'Boolean = Request(rType As RequestType, [FileName], [DefaultExt],
' [InitDir], [Filter], [FilterIndex])
'Call Confirm(cType As ConfirmationType)
'Call Modify
'----------------------------- EXAMPLES -----------------------------'
'Say, you want a form that display, modify and save documents.
'First reference COMDLG32.OCX in your project components and add a Common
'Dialog Control (CommonDialog1) to your form.
'First reference COMDLG32.OCX in your project components and add a Common
'Dialog Control (CommonDialog1) to your form. Add buttons to create
'(btn_Create), open (btn_Reopen), reopen (btn_reopen), save (btn_Save),
'save as (btn_SaveAs) and close (btn_Close).
'Then your form code is nothing but that:
'
' Private WithEvents DocInApp As objDocInApp
' Private Sub Form_Load()
' Set DocInApp = New objDocInApp
' Call DocInApp.SetDialogBox(CommonDialog1)
' End Sub
' Private Sub btn_Create_Click()
' Call DocInApp.AskNew
' End Sub
' Private Sub btn_Open_Click()
' Call DocInApp.AskOpen
' End Sub
' Private Sub btn_reopen_Click()
' Call DocInApp.AskReOpen
' End Sub
' Private Sub btn_Save_Click()
' Call DocInApp.AskSave
' End Sub
' Private Sub btn_SaveAs_Click()
' Call DocInApp.AskSave(True)
' End Sub
' Private Sub btn_Close_Click()
' Call DocInApp.AskClose
' End Sub
' Private Sub Form_Unload(Cancel As Integer)
' If Not DocInApp.AskClose Then Cancel = 1
' End Sub
' Private Sub DocInApp_CreateDoc(Title As String)
' 'Write here the way you create a new document (blank, not saved)
' 'Do not consider any user interaction, DocInApp does it for you
' On Error GoTo Err_Unattend
' 'Do not forgot to confirm creation
' DocInApp.ConfirmCreate
' Err_Unattend:
' 'Let DocInApp display the error message
' End Sub
' Private Sub DocInApp_OpenDoc(Path As String, Title As String)
' 'Write here the way you display a file from address "Path"
' 'Do not consider any user interaction, DocInApp does it for you
' On Error GoTo Err_Unattend
' 'Do not forgot to confirm opening
' DocInApp.ConfirmOpen
' Err_Unattend:
' 'Let DocInApp display the error message
' End Sub
' Private Sub DocInApp_SaveDoc(Path As String, Title As String)
' 'Write here the way you save a document to address "Path"
' 'Do not consider any user interaction, DocInApp does it for you
' On Error GoTo Err_Unattend
' 'Do not forgot to confirm save
' DocInApp.ConfirmSave
' Err_Unattend:
' 'Let DocInApp display the error message
' End Sub
' Private Sub DocInApp_CloseDoc()
' 'Write here the way you close a document
' 'Do not consider any user interaction, DocInApp does it for you
' On Error GoTo Err_Unattend
' 'Do not forgot to confirm close
' DocInApp.ConfirmClose
' Err_Unattend:
' 'Let DocInApp display the error message
' End Sub
'------------------------------- BUGS -------------------------------'
'If your application raises an error while creating, opening or reopening
'a document, it is asked to close it.
'If your application raises an error while closing the document, you may
'have a half-created or half-opened document displayed.
'In both cases, an error message is displayed.
'Options "dlgNoReadOnlySelect" only works for save as dialog box. It means
'that "objDocInApp" may return a read-only or right-protected document
'after a "AskOpen" method and without being aware of it. The bug occurs
'when invoquing the "AskSave" method.
'----------------------------- SOURCES ------------------------------'
'MSDN January 2001
'------------------------ REQUIRED LIBRARIES ------------------------'
'msvbvm60.dll, VB6.OLB, VB6FR.DLL (Always required)
'COMDLG32.OCX (Common Dialog Control)
'-------------------- REQUIRED MODULES AND FORMS --------------------'
'None
'----------------------------- OPTIONS ------------------------------'
Option Base 0
Option Compare Text
Option Explicit
'+----------------------------------------------------------------------+'
'+ CONSTANTS +'
'+----------------------------------------------------------------------+'
'+----------------------------------------------------------------------+'
'+ TYPES AND ENUMS +'
'+----------------------------------------------------------------------+'
'Enum: dlgOptions
' Enumeration of the options to setup the open/save file dialog box.
'------------------------------------------------------------------------'
Enum dlgOptions
'(Open/Save) Dialog box will not follow shell links (shortcuts)
dlgNoFollowLinks = cdlOFNNoDereferenceLinks
'(Open/Save) Dialog box will not modify CurDir value
dlgNoChangeCurDir = cdlOFNNoChangeDir
'(Open) Dialog box will not display read-only check box
dlgHideReadOnlyCheckBox = cdlOFNHideReadOnly
'(Open) Dialog box will check read-only check box
dlgCheckReadOnly = cdlOFNReadOnly
'(Open) User will be prompted to create inexistent file
dlgCreatePrompt = cdlOFNCreatePrompt
'(Save) User will be prompted to overwrite existing file
dlgOverWritePrompt = cdlOFNOverwritePrompt
End Enum
'------------------------------------------------------------------------'
'Enum: RequestType
' Enumeration of the request types accessible to application.
'------------------------------------------------------------------------'
Enum RequestType
reqNew
reqOpen
reqReOpen
reqSave
reqSaveAs
reqClose
reqProperties
End Enum
'------------------------------------------------------------------------'
'Enum: ConfirmType
' Enumeration of the events confirmation accessible to application.
'------------------------------------------------------------------------'
Enum ConfirmationType
confNew
confOpen
confSave
confClose
End Enum
'+----------------------------------------------------------------------+'
'+ EVENTS +'
'+----------------------------------------------------------------------+'
' Events are raised to notify the application to actually display or
' close documents or perfom read/write operations on files.
'------------------------------------------------------------------------'
'Event: CreateDoc
' Parameters: None
'------------------------------------------------------------------------'
Event NewDoc()
'------------------------------------------------------------------------'
'Event: OpenDoc
' Parameters: Path: (String) The absolute path to a specific file.
'------------------------------------------------------------------------'
Event OpenDoc(Path As String)
'------------------------------------------------------------------------'
'Event: SaveDoc
' Parameters: Path: (String) The absolute path to a specific file.
'------------------------------------------------------------------------'
Event SaveDoc(Path As String)
'------------------------------------------------------------------------'
'Event: CloseDoc
' Parameters: None
'------------------------------------------------------------------------'
Event CloseDoc()
'+----------------------------------------------------------------------+'
'+ PROPERTIES +'
'+----------------------------------------------------------------------+'
'Common Dialog Control used for dialog boxes (write only).
'------------------------------------------------------------------------'
Private ComDlg As Control
'------------------------------------------------------------------------'
'Buttons of the application managed by the object.
'------------------------------------------------------------------------'
Private btnReopen
Private btnSave
Private btnSaveAs
Private btnClose
Private btnProp
'------------------------------------------------------------------------'
'Status of the document in calling application (write only).
'------------------------------------------------------------------------'
Private Created As Boolean
Private Opened As Boolean
Private Modified As Boolean
Private Saved As Boolean
Private Closed As Boolean
'------------------------------------------------------------------------'
'Document properties in calling application (read only).
'------------------------------------------------------------------------'
Private docPath As String
Private docName As String
Private docExt As String
Private docReadOnly As Boolean
'------------------------------------------------------------------------'
'Next document properties (neither read nor write).
'------------------------------------------------------------------------'
Private newPath As String
Private newName As String
Private newExt As String
Private newReadOnly As Boolean
'------------------------------------------------------------------------'
'Captions and messages of the interface (write only).
'------------------------------------------------------------------------'
Private wrnReopen As String
Private wrnModified As String
Private wrnReadOnly As String
Private captOpen As String
Private captSaveAs As String
Private captReadOnly As String
Private errNew As String
Private errOpen As String
Private errSave As String
Private errClose As String
Private docDefaultName As String
Private docDefaultExt As String
Private docDefaultFilter As String
'------------------------------------------------------------------------'
'Properties accessible to the application.
'------------------------------------------------------------------------'
Property Get Path() As String
Path = docPath
End Property
Property Get Name() As String
Name = docName
End Property
Property Get Ext() As String
Ext = docExt
End Property
Property Get ReadOnly() As String
ReadOnly = docReadOnly
End Property
'+----------------------------------------------------------------------+'
'+ INITIALIZE +'
'+----------------------------------------------------------------------+'
'Sub: Class_Initialize
' Executed when an instance of the class is created.
' Parameters: None
'------------------------------------------------------------------------'
Private Sub Class_Initialize()
'Set default language
SetLanguage _
"If you reopen a file, all changes will be lost." & vbCrLf & _
"Are you sure you want to reopen %0?", _
"The containt of file %0 has been modified." & vbCrLf & _
"Would you like to save changes?", _
"%0 is read-only." & vbCrLf & _
"To save a copy, clic OK and give the document a differen" & _
"t name in the Save as dialog box.", _
"Open", "Save as", "Read-only", _
"Unable to create %0.", _
"Unable to open %0.", _
"Unable to save %0.", _
"Unable to close %0.", _
"New document", "txt", "All files (*.*)|*.*"
End Sub
'------------------------------------------------------------------------'
'Sub: SetDialog
' Set the Common Dialog Control and options used for the open/save file
' dialog boxes.
' Parameters: CommonDialogControl: The reference to a control.
' DialogOptions (Optional): The options to setup the
' open/save file dialog box, see Enum dlgOptions for
' more informations.
'------------------------------------------------------------------------'
Sub SetDialog(CommonDialogControl As Control, Optional DialogOptions As _
dlgOptions)
DialogOptions = dlgOverWritePrompt
On Error Resume Next
Set ComDlg = CommonDialogControl
ComDlg.CancelError = True
ComDlg.Flags = cdlOFNExplorer _
+ cdlOFNFileMustExist _
+ cdlOFNNoReadOnlyReturn _
+ DialogOptions
End Sub
'------------------------------------------------------------------------'
'Sub: SetButtons
' Set the buttons managed by the object. objDocInApp can enable or
' disable controls depending on the document status.
' Parameters: ArrayOfButtonsReOpen (Optional): An array of controls of
' the application that are used to reopen documents
' ArrayOfButtonsSave (Optional): An array of controls of the
' application that are used to save documents
' ArrayOfButtonsSaveAs (Optional): An array of controls of
' the application that are used to save documents as
' ArrayOfButtonsClose (Optional): An array of controls of
' the application that are used to close documents
' ArrayOfButtonsProperties (Optional): An array of controls
' of the application that are used to get documents
' properties
'------------------------------------------------------------------------'
Sub SetButtons(Optional ArrayOfButtonsReOpen, Optional _
ArrayOfButtonsSave, Optional ArrayOfButtonsSaveAs, Optional _
ArrayOfButtonsClose, Optional ArrayOfButtonsProperties)
On Error Resume Next
btnReopen = ArrayOfButtonsReOpen
btnSave = ArrayOfButtonsSave
btnSaveAs = ArrayOfButtonsSaveAs
btnClose = ArrayOfButtonsClose
btnProp = ArrayOfButtonsProperties
End Sub
'------------------------------------------------------------------------'
'Sub: SetLanguage
' Set the messages displayed by the object. To display the name of the
' document in a string, use %0.
' Parameters: ReopenWarning (Optional): The message displayed before a
' document is reopened
' ModifiedWarning (Optional): The message displayed when
' closing a modified not saved document
' ReadOnlyWarning (Optional): The message displayed when
' saving a read-only document
' OpenCaption (Optional): The caption of the "Open" file
' dialog box
' SaveAsCaption (Optional): The caption of the "Save as"
' file dialog box
' ReadOnlyCaption (Optional): The caption of a file that is
' open with read-only attributes
' NewError (Optional): The message displayed when
' application was unable to create a new document
' OpenError (Optional): The message displayed when
' application was unable to open a document
' SaveError (Optional): The message displayed when
' application was unable to save a document
' CloseError (Optional): The message displayed when
' application was unable to close a document
' DocumentDefaultName (Optional): The default name given to
' new document
' DocumentDefaultExt (Optional): The default extension given
' to new document
' DocumentDefaultFilter (Optional): The default filter used
' by the open/save file dialog boxes
'------------------------------------------------------------------------'
Sub SetLanguage(Optional ReopenWarning, Optional ModifiedWarning, _
Optional ReadOnlyWarning, Optional OpenCaption, Optional SaveAsCaption, _
Optional ReadOnlyCaption, Optional NewError, Optional OpenError, _
Optional SaveError, Optional CloseError, Optional DocumentDefaultName, _
Optional DocumentDefaultExt, Optional DocumentDefaultFilter)
If Not IsMissing(ReopenWarning) _
Then wrnReopen = ReopenWarning
If Not IsMissing(ModifiedWarning) _
Then wrnModified = ModifiedWarning
If Not IsMissing(ReadOnlyWarning) _
Then wrnModified = ModifiedWarning
If Not IsMissing(OpenCaption) _
Then captOpen = OpenCaption
If Not IsMissing(SaveAsCaption) _
Then captSaveAs = SaveAsCaption
If Not IsMissing(ReadOnlyCaption) _
Then captReadOnly = ReadOnlyCaption
If Not IsMissing(NewError) _
Then errNew = NewError
If Not IsMissing(OpenError) _
Then errOpen = OpenError
If Not IsMissing(SaveError) _
Then errSave = SaveError
If Not IsMissing(CloseError) _
Then errClose = CloseError
If Not IsMissing(DocumentDefaultName) _
Then docDefaultName = DocumentDefaultName
If Not IsMissing(DocumentDefaultExt) _
Then docDefaultExt = DocumentDefaultExt
If Not IsMissing(DocumentDefaultFilter) _
Then docDefaultFilter = DocumentDefaultFilter
End Sub
'+----------------------------------------------------------------------+'
'+ REQUEST +'
'+----------------------------------------------------------------------+'
'Function: Request
' Perform requested action on the active document. Returns "True" if the
' action was succesfully completed.
' Parameters: rType: Numeric value (Long) indicating the type of action
' to perform. See Enum "RequestType" for values.
' FileName (Optional):
' DefaultExt (Optional):
' InitDir (Optional):
' Filter (Optional):
' FilterIndex (Optional):
'------------------------------------------------------------------------'
Function Request(rType As RequestType, Optional FileName, Optional _
DefaultExt, Optional InitDir, Optional Filter, Optional FilterIndex) As _
Boolean
Dim NextAction As String
Select Case rType
'Case new document
Case reqNew
'Ask to close active document
If AskClose(InitDir, Filter, FilterIndex, DefaultExt) Then
'Ask to make a new document
If AskNew(FileName, DefaultExt) Then
'Complete action "close"
If ActionClose() Then
'Complete action "new"
Request = ActionNew()
End If
End If
End If
'Case open document
Case reqOpen
'Ask to close active document
If AskClose(InitDir, Filter, FilterIndex, DefaultExt) Then
'Ask to select a document
If AskOpen(FileName, InitDir, Filter, FilterIndex) Then
'Complete action "close"
If ActionClose() Then
'Complete action "open"
Request = ActionOpen()
End If
End If
End If
'Case re-open document
Case reqReOpen
'Ask to confirm re-open
If AskReOpen() Then
'Complete action "close"
If ActionClose() Then
'Complete action "open"
Request = ActionOpen()
End If
End If
'Case save document
Case reqSave
'Ask to save document
If AskSave(InitDir, Filter, FilterIndex, DefaultExt) Then
'Complete action "save"
Request = ActionSave()
End If
'Case save document as
Case reqSaveAs
'Ask to save the document as
If AskSaveAs(FileName, InitDir, _
Filter, FilterIndex, DefaultExt) Then
'Complete action "save"
Request = ActionSave()
End If
'Case close document
Case reqClose
'Ask to close active document
If AskClose(InitDir, Filter, FilterIndex, DefaultExt) Then
'Complete action "close"
Request = ActionClose()
End If
Case reqProperties
MsgBox "Not available yet."
End Select
End Function
'+----------------------------------------------------------------------+'
'+ QUESTIONS +'
'+----------------------------------------------------------------------+'
'Function: AskNew
' Prepares new attributes.
' Returns "True".
' Parameters: FileName (Optional): A string expression that specify
' the name of the new document (it is not a path).
' DefaultExt (Optional): A string expression that specify
' the extension of the new document.
'------------------------------------------------------------------------'
Private Function AskNew(Optional FileName, Optional DefaultExt) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
'Set new document path
newPath = ""
'Set new document name
If IsMissing(FileName) _
Then newName = docDefaultName _
Else newName = FSO.GetBaseName(FileName)
'Set document extension
If IsMissing(DefaultExt) _
Then newExt = docDefaultExt _
Else newExt = DefaultExt
'Set document status
newReadOnly = False
'Returns succes
AskNew = True
End Function
'------------------------------------------------------------------------'
'Function: AskOpen
' Prompt the user to select a file to open and store selection in global
' variables "newPath", "newName", "newExt" and "newReadOnly".
' Returns "True" if the user pressed OK, "False" if he pressed Cancel.
' Parameters: FileName (Optional): A string expression that specify the
' filename displayed (and selected) first in the open
' file dialog box. It may include drive, path, pattern
' and qualified network path. In such case it overrides
' InitDir parameter.
' InitDir (Optional): A string expression that specify the
' directory displayed first in the open file dialog box.
' Filter (Optional): A string expression that specify wich
' type of file the user is allowed to select.
' Syntax "Description1|Filter1|Description2|Filter2"
' Parts: Description: A string expression describing the
' type of file.
' Filter: A string expression specifying the
' filename extensions.
' Use the pipe ("|") to separate the description
' and filter values and use the semicolon (";")
' to separate extensions.
' FilterIndex (Optional): A numeric expression specifying
' the default filter
'------------------------------------------------------------------------'
Private Function AskOpen(Optional FileName, Optional InitDir, Optional _
Filter, Optional FilterIndex) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo Err_UserPressCancel
'Set dialog box caption
ComDlg.DialogTitle = captOpen
'Set dialog box initial directory
If IsMissing(InitDir) _
Then ComDlg.InitDir = "" _
Else ComDlg.InitDir = InitDir
'Set dialog box initial filename
If IsMissing(FileName) _
Then ComDlg.FileName = "" _
Else ComDlg.FileName = FileName
'Set dialog box filter
If IsMissing(Filter) _
Then ComDlg.Filter = docDefaultFilter _
Else ComDlg.Filter = Filter
'Set dialog box filter index
If IsMissing(FilterIndex) _
Then ComDlg.FilterIndex = 1 _
Else ComDlg.FilterIndex = FilterIndex
'Show open file dialog box
ComDlg.ShowOpen
'Store user selection in newVariables
newPath = ComDlg.FileName
newName = ComDlg.FileTitle
newExt = FSO.GetExtensionName(newPath)
newReadOnly = CBool(ComDlg.Flags And cdlOFNReadOnly) _
Or CBool(FSO.GetFile(newPath).Attributes And 1)
'Return success
AskOpen = True
Exit Function
'User pressed cancel
Err_UserPressCancel:
End Function
'------------------------------------------------------------------------'
'Function: AskReOpen
' Prompt the user about risks of losing changes.
' Returns "True" if the user confirms re-opening, "False" if not.
' Parameters: None
'------------------------------------------------------------------------'
Private Function AskReOpen() As Boolean
'Prompt user
Select Case MsgBoxA(wrnReopen, vbQuestion + vbYesNoCancel)
Case vbYes
'Set newVariables to previous value
newPath = docPath
newName = docName
newExt = docExt
newReadOnly = docReadOnly
'Return success
AskReOpen = True
End Select
End Function
'------------------------------------------------------------------------'
'Function: AskSave
' Returns "True" if the document can actually be saved to its current
' path. Otherwise, returns the "AskSavAs" answer.
' Parameters: InitDir (Optional): A string expression that specify the
' directory displayed first in the save file dialog box.
' Used only in case document has no path (new document).
' Filter (Optional): A string expression that specify wich
' type of file the user is allowed to select. Used only
' if document has to be saved as.
' Syntax "Description1|Filter1|Description2|Filter2"
' Parts: Description: A string expression describing the
' type of file.
' Filter: A string expression specifying the
' filename extensions.
' Use the pipe ("|") to separate the description
' and filter values and use the semicolon (";")
' to separate extensions.
' FilterIndex (Optional): A numeric expression specifying
' the default filter
' DefaultExt (Optional): A string expression that specify
' wich extension is added to filename if no extension
' and no filter is specified ("*.*") or if extension
' does not fit filter specifications nor any known file
' type. Used only if document has to be saved as.
'------------------------------------------------------------------------'
Private Function AskSave(Optional InitDir, Optional Filter, Optional _
FilterIndex, Optional DefaultExt) As Boolean
'If document has no path (new document)
If docPath = "" Then
AskSave = AskSaveAs(docName, InitDir, Filter, _
FilterIndex, docExt)
'If document has a path
Else
'If document is read-only
If docReadOnly Then
Call MsgBoxA(wrnReadOnly, vbExclamation)
AskSave = AskSaveAs(docPath, , Filter, _
FilterIndex, docExt)
'Document has a path and is not read-only
Else
newPath = docPath
newName = docName
newExt = docExt
newReadOnly = docReadOnly
'Ready to save
AskSave = True
End If
End If
End Function
'------------------------------------------------------------------------'
'Function: AskSaveAs
' Prompt the user to select a path to save the active document and store
' selection in global variables "newPath", "newName", "newExt" and
' "newReadOnly".
' Returns "True" if the user pressed OK, "False" if he pressed Cancel.
' Parameters: FileName (Optional): A string expression that specify the
' filename displayed (and selected) first in the save
' file dialog box. It may include drive, path, pattern
' and qualified network path. In such case it overrides
' InitDir parameter.
' InitDir (Optional): A string expression that specify the
' directory displayed first in the save file dialog box.
' Filter (Optional): A string expression that specify wich
' type of file the user is allowed to select.
' Syntax "Description1|Filter1|Description2|Filter2"
' Parts: Description: A string expression describing the
' type of file.
' Filter: A string expression specifying the
' filename extensions.
' Use the pipe ("|") to separate the description
' and filter values and use the semicolon (";")
' to separate extensions.
' FilterIndex (Optional): A numeric expression specifying
' the default filter
' DefaultExt (Optional): A string expression that specify
' wich extension is added to filename if no extension
' and no filter is specified ("*.*") or if extension
' does not fit filter specifications nor any known file
' type.
'------------------------------------------------------------------------'
Private Function AskSaveAs(Optional FileName, Optional InitDir, Optional _
Filter, Optional FilterIndex, Optional DefaultExt) As Boolean
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error GoTo Err_UserPressCancel
'If there is an active document
If docName <> "" Then
'Set dialog box caption
ComDlg.DialogTitle = captSaveAs
'Set dialog box initial directory
If IsMissing(InitDir) _
Then ComDlg.InitDir = FSO.GetParentFolder(docPath) _
Else ComDlg.InitDir = InitDir
'Set dialog box initial filename
If IsMissing(FileName) _
Then ComDlg.FileName = docName _
Else ComDlg.FileName = FileName
'Set dialog box filter
If IsMissing(Filter) _
Then ComDlg.Filter = docDefaultFilter _
Else ComDlg.Filter = Filter
'Set dialog box filter index
If IsMissing(FilterIndex) _
Then ComDlg.FilterIndex = 1 _
Else ComDlg.FilterIndex = FilterIndex
'Set dialog box default extension
If IsMissing(DefaultExt) _
Then ComDlg.DefaultExt = docDefaultExt _
Else ComDlg.DefaultExt = DefaultExt
'Show save file dialog box
ComDlg.ShowSave
'Store user selection in newVariables
newPath = ComDlg.FileName
newName = ComDlg.FileTitle
newExt = FSO.GetExtensionName(newPath)
newReadOnly = False
End If
'Return success
AskSaveAs = True
Exit Function
'User pressed cancel
Err_UserPressCancel:
End Function
'------------------------------------------------------------------------'
'Function: AskClose
' Prompt the user to save changes.
' Returns "True" if the user pressed No, "False" if he pressed Cancel.
' If the user chooses Yes, returns "True" only after document was
' succesfully saved.
' Parameters: InitDir (Optional): A string expression that specify the
' directory displayed first in the save file dialog box.