Petit log concernant le commondialog


Télécharger le projet
Commenter

Description

Permet d'ecrire du texte et de l'enregistrer et aussi de l'ouvrir. Possibilité de changer la couleur en affichant la boite de dialogue couleur.

Source / Exemple : 


Option Explicit
Dim fso As FileSystemObject
Dim fic As TextStream

Private Sub cmdchar_Click()

   ' gestion de l'erreur
   On Error Resume Next
   
   ' si l'utilisateur clik sur annuler on gere l'erreur
   cd1.CancelError = True
   
   ' definit les fonction de la boite de dialogue police
   cd1.Flags = cdlCFBoth Or cdlCFForceFontExist
   
   'on initialise le command dialogue
   cd1.FontBold = txt.FontBold
   cd1.FontItalic = txt.FontItalic
   cd1.FontName = txt.FontName
   cd1.FontSize = txt.FontSize
   
   ' affichage du command dialogue
   cd1.ShowFont
   
   'si pas d'erreur
   If Err.Number = 0 Then

      'le texte prend les valeurs que l'utilisateur a définit ds le command dialogue
      txt.FontBold = cd1.FontBold
      txt.FontItalic = cd1.FontItalic
      txt.FontName = cd1.FontName
      txt.FontSize = cd1.FontSize
   
   Else
      
      'si erreur on affiche l'erreur
      MsgBox Err.Description

   End If
         
End Sub

Private Sub cmdcolor_Click()
   
   ' gestion erreur
   On Error Resume Next
   
   ' on gere l'erreur si l'utilisateur clik sur annuler
   cd1.CancelError = True
   
   'definit les fonctions de la boite de dialogue couleur
   cd1.Flags = cdlCCFullOpen Or cdlCCRGBInit
   
   'initialise la couleur du texte avant de la modifier
   cd1.Color = txt.ForeColor
   
   'affichage de la boite de dialogue couleur
   cd1.ShowColor
   
   'si il n'y a pas d'erreur alors
   If Err.Number = 0 Then
   
      'le texte prend la couleur selectionné ds la boite de dialogue
      txt.ForeColor = cd1.Color
      
   Else
   
      ' sinon on affiche l'erreur
      MsgBox Err.Description
      
   End If
   
End Sub

Private Sub cmdouvrir_Click()

   Set fso = Nothing
   
   Set fic = Nothing
   
   'evite l'apparition d'erreur si l'utilisateur clique sur annuler
   cd1.CancelError = False
   
   'gere les erreurs tel que chemin ou dossier introuvable
   cd1.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist
   
   'fait apparaitre seulement les fichier tmp et tous
   cd1.Filter = "Fichiers (*.tmp)|*.tmp|Tous (*.*)|*.*"
   
   'ouvre la fenetre de recherche
   cd1.ShowOpen
   
   'si le nom du fichier a ouvrir est sup a 0
   If Len(cd1.FileName) > 0 Then
   
      ' creation de l'objet
      Set fso = New FileSystemObject
      
      'ouverture pour lecture du fichier
      Set fic = fso.OpenTextFile(cd1.FileName, ForReading)
      
      'lecture du fichier jusqu'a la derniere ligne
      Do While fic.AtEndOfStream = False
      
         ' renvoit sur l'ihm ce k'il y a ds le fichier
         txt.Text = txt.Text & fic.ReadLine & vbNewLine
         
      Loop
      
   End If

End Sub

Private Sub cmdwrite_Click()

   Set fso = Nothing
   
   Set fic = Nothing

   cd1.CancelError = False
   
   cd1.Flags = cdlOFNPathMustExist Or cdlOFNOverwritePrompt
   
   cd1.Filter = "Fichiers (*.temp)|*.tmp|Tous (*.*)|*.*"
   
   cd1.ShowSave
   
   If Len(cd1.FileName) > 0 Then
   
     Set fso = New FileSystemObject
     
      'ouverture pour ecriture sur le fichier
     Set fic = fso.OpenTextFile(cd1.FileName, ForAppending, True)
     
     'ecriture  de ce kil y a ds la text box dans le fichier
     fic.WriteLine (txt.Text)
     
   End If

End Sub
Private Sub Form_Unload(Cancel As Integer)
   
   'destruction de l'objet
   Set fso = Nothing
   
   'destruction du fichier
   Set fic = Nothing

End Sub
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (djls)