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
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.