Ayoubpad2009
Description
un programe de Modification du text comme word pad qui pérmier de faire des fichier 'txt'asp'html'vbscript'ay'.......
c'est un source gratouit pour tester et ajouter ....................
Source / Exemple :
'************************************************************
' AyoubPad '
' by Ayoube Errabi ' *
' l'utilisation de se source de se programe il gratouit ' *
' Copyright © Ayoube Errabi 2009-2010 ' *
'************************************************************
'---------------------------------------------------------------------------------------------------------------------
'total line
Private Declare Function SendMessageLong Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const EM_GETLINECOUNT = &HBA
'-----------------------------------------------------------------------------------------------------------------------------
Dim FNum As Integer
Dim txt As String 'definition des varriables
Dim X As Integer
Private Sub About_Click(Index As Integer)
frmAbout.Show 'about
End Sub
Private Sub Annuler_Click(Index As Integer)
On Error Resume Next
DoEditThing "Undo", Form1.rtetext
End Sub
Private Sub Arabe_Click(Index As Integer)
On Error Resume Next
MDIForm1.Command3.Caption = "ÚÇã" 'pour changementle langue [arabe]
MDIForm1.Command1.Caption = " ÈÏÇ"
MDIForm1.Label4.Caption = " ÈÍÊ"
MDIForm1.option.Caption = "ÇÚÏÇÏ"
MDIForm1.Label5.Caption = " ÇÎÑ ÇáãáÝÇÊ"
Form1.Caption = "ßÊÇÈÉ"
End Sub
Private Sub azdd_Click(Index As Integer)
On Error Resume Next
Dim objWord
Dim tmpObjWord
Dim strResults
' Only continue if user has typed text into the text box.
If Len(Form1.rtetext.Text) < 1 Then Exit Sub
Set tmpObjWord = CreateObject("Word.Application")
' check if there are any spelling errors.
If tmpObjWord.CheckSpelling(Form1.rtetext.Text) Then
MsgBox "The text spelled correctly"
' free memory
Set tmpObjWord = Nothing
' exit sub - No spelling errors are found.
Exit Sub
End If
'free memory
Set tmpObjWord = Nothing
Set objWord = CreateObject("Word.Application")
With objWord
' hide the Word application
.Visible = False
' Spell checker only works within a document
.Documents.Add
' Put the text in the document
.Selection.TypeText Form1.rtetext.Text
' disallow grammer checking. To allow it set it to "True"
.Options.CheckGrammarWithSpelling = False
.Options.IgnoreUppercase = False
' Perform the spell checking
.ActiveDocument.CheckSpelling
' Select the new, corrected text
.Selection.WholeStory
' Copy Corrected text to Clipboard
.Selection.Copy
' strResults holds the text after the spell corrections
strResults = .Selection.Text
' close and free memory
.ActiveDocument.Close (0)
.Quit
End With
Set objWord = Nothing
' retrieve the corrected text from the clipboard
Form1.rtetext.Text = Clipboard.GetText
End Sub
Private Sub Backcolor_Click(Index As Integer)
On Error GoTo Bottom
Form1.CommonDialog1.Color = Form1.rtetext.Backcolor '-------------------->ayoube
Form1.CommonDialog1.Flags = 0 'cdlCCFullOpen
Form1.CommonDialog1.ShowColor 'changemment de Backcolor de form1.rtext. Backcolor
Form1.rtetext.Backcolor = Form1.CommonDialog1.Color
Form1.Backcolor = Form1.CommonDialog1.Color
Bottom:
End Sub
Private Sub cboFontName_Change()
On Error Resume Next
Form1.rtetext.Font = cboFontName.Text 'changer le font de form1
End Sub
Private Sub cboFontName_Click()
On Error Resume Next
Form1.rtetext.SelFontName = cboFontName.Text 'Set selected font name
End Sub
Private Sub Coller_Click(Index As Integer)
On Error Resume Next
Form1.rtetext.SelText = Clipboard.GetText() 'coller
End Sub
Private Sub Command1_Click()
On Error Resume Next
Dim textfound As Integer
Form1.rtetext.Find (Text4.Text) 'recherche des mot
Form1.rtetext.SetFocus
textfound = Form1.rtetext.Find(Text4.Text)
If textfound = -1 Then
MsgBox vbCr & " mot non trouve .", vbInformation, "ayoubepad"
End If
End Sub
Private Sub Command2_Click()
Picture1.Visible = False 'show picture
End Sub
Private Sub Command4_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Command4.left = Command4.left + 100
Form1.Frame1.Visible = True '***************2009*******************************
Form1.Line2.Visible = True
Form1.Line1.X1 = Command4.left + 100
Form1.Line1.X2 = Command4.left + 100 'move de barr
Form1.Frame1.left = Command4.left + 100
Form1.rtetext.SelAlignment = 2
Timer1.Enabled = True
End Sub
Private Sub Copier_Click(Index As Integer)
On Error Resume Next
Clipboard.SetText Form1.rtetext.SelText 'copier
End Sub
Private Sub Couper_Click(Index As Integer)
On Error Resume Next
Clipboard.Clear
Clipboard.SetText Form1.rtetext.SelText 'couper
Form1.rtetext.SelText = ""
End Sub
Private Sub Descryp_Click(Index As Integer)
On Error Resume Next
For I = 1 To Len(Form1.rtetext.Text)
st1 = Mid(Form1.rtetext.Text, I, 1)
as1 = Asc(st1)
ch1 = Chr(255 - as1)
st = st + ch1
Next
Form1.rtetext.Text = st
End Sub
Private Sub Documment_Click(Index As Integer)
On Error Resume Next
'** Description:
'** Create a new document
Dim frm2 As Form1
Static DocCount As Long '2009
Set frm2 = New Form1
DocCount = DocCount + 1
frm2.Caption = "Documment" & DocCount & "[Création] :" 'caption de nouveau
frm2.Show
End Sub
Private Sub Effacer_Click(Index As Integer)
On Error Resume Next
Form1.rtetext.Text = "" 'effacer
End Sub
Private Sub Encryp_Click(Index As Integer)
On Error Resume Next
For I = 1 To Len(Form1.rtetext.Text)
st1 = Mid(Form1.rtetext.Text, I, 1)
as1 = Asc(st1)
ch1 = Chr(255 - as1)
st = st + ch1
Next
Form1.rtetext.Text = st
End Sub
Private Sub Enregistrersous_Click(Index As Integer)
On Error Resume Next
Dim FNum As Integer
Dim txt As String
On Error Resume Next 'Enregistrersous sous la form ;html,ay,vbs,txt
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNOverwritePrompt
CommonDialog1.Filter = "SDI Documents *.ay|*.ay|Text Files *.txt|*.TXT|HTML Files *.html|*.HTML|HTM Files *.htm|*.HTM|VBscript Files *.vbs|*.VBS|All files|*.*"
CommonDialog1.ShowSave
FNum = FreeFile
Open CommonDialog1.FileName For Output As #1
Print #FNum, Form1.rtetext.Text
Close #FNum
OpenFile = CommonDialog1.FileName
'-----------------------------ini
Dim nj As Long
Dim FilePath As String
nj = FreeFile()
FilePath = App.Path & "\ini\setting.ini" 'création de fichier ini
Open FilePath For Output As #nj
Print #nj, Text1.Text
Close #nj
Exit Sub
End Sub
Private Sub ett_Click(Index As Integer)
Form3.Show
End Sub
Private Sub false_Click(Index As Integer)
Picture1.Visible = False
End Sub
Private Sub flj_Click(Index As Integer)
Dim FNum As Integer
Dim txt As String
On Error Resume Next
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNFileMustExist
CommonDialog1.Filter = "Rich Text Format(*.rtf)|*.rtf|HTML Files(*.htm,*.html,*.asp,*.js,*.css)|*.htm;*.html;*.asp;*.js;*.css|Dat Files(*.Dat)|*.dat|All Files(*.*)|*.*"
CommonDialog1.ShowOpen
FNum = FreeFile
Open CommonDialog1.FileName For Input As #1
txt = Input(LOF(FNum), #FNum)
Close #FNum
Form1.rtetext.Text = txt
OpenFile = CommonDialog1.FileName
code: ss = FileDateTime(CommonDialog1.FileName) 'date de création
Form3.Label4.Caption = "Date de Création :" & ss
Open (CommonDialog1.FileName) For Binary As #1 'taille de fichier
Form3.Label3.Caption = "Taille :" & LOF(1) & " Byte"
Form3.Hide
Close 1
Exit Sub
End Sub
Private Sub gg_Click(Index As Integer)
On Error GoTo Bottom
Form1.CommonDialog1.Color = Form1.rtetext.SelColor
Form1.CommonDialog1.Flags = 0 'cdlCCFullOpen
Form1.CommonDialog1.ShowColor
Form1.rtetext.SelColor = Form1.CommonDialog1.Color
Form1.FillColor = Form1.CommonDialog1.Color
Bottom:
End Sub
Private Sub Help_Click(Index As Integer)
Form1.rtetext.Refresh
End Sub
Private Sub html_Click(Index As Integer)
Form1.rtetext.SelColor = (&HFF0000)
Form1.rtetext.Backcolor = &H80FF80
Form1.Caption = " Création: [html],[css],[VBscript]"
Form1.Frame1.Backcolor = &H80FF80
If Dir(App.Path & "\ini\html.ini") <> "" Then
GoTo sYs
Else
End If
sYs:
Dim nj As String
Open App.Path & "\ini\html.ini" For Input As #1
Input #1, nj
Form1.rtetext.Text = nj
Close #1
End Sub
Private Sub Imprimer_Click(Index As Integer)
Call Form1.rtetext.SelPrint(Printer.hdc)
End Sub
Private Sub max_Click(Index As Integer)
Form1.WindowState = 2
End Sub
Private Sub MDIForm_Load()
frmsm.Hide
Form1.Show
basesave.Hide
Form3.Hide
Text1.Text = Form1.rtetext.Text
Dim counter As Integer
For counter = 0 To Screen.FontCount - 1
cboFontName.AddItem Screen.Fonts(counter)
Next
'--------------------------------ini
If Dir(App.Path & "\ini\setting.ini") <> "" Then
GoTo sYs
Else
End If
sYs:
Dim nj As String
Open App.Path & "\ini\setting.ini" For Input As #1
Input #1, nj
Text6.Text = nj
Close #1
End Sub
Sub creatnewDocument()
Form1.rtetext = "" 'sub de création de document
Form1.Caption = "sans titre"
End Sub
Private Sub mini_Click(Index As Integer)
Form1.WindowState = 0
End Sub
Private Sub New_Click(Index As Integer)
Form1.rtetext.Backcolor = &H80000009
Form1.Caption = "Documment[Création ]: "
Form1.rtetext.Text = ""
Form1.Frame1.Backcolor = &HFFFFFF
End Sub
Private Sub objet_Click(Index As Integer)
On Error GoTo Bottom
Form1.OLE1.InsertObjDlg
If Form1.OLE1.OLEType = vbOLENone Then GoTo Bottom
Screen.MousePointer = vbHourglass
If Form1.OLE1.OLEType = vbOLEEmbedded Then
Form1.rtetext.OLEObjects.Add , , , Form1.OLE1.Class
ElseIf fMainForm.OLE1.OLEType = vbOLELinked Then
Form1.rtetext.OLEObjects.Add , , Form1.OLE1.SourceDoc, OLE1.Class
End If
Bottom:
Screen.MousePointer = vbDefault
End Sub
Private Sub open_Click(Index As Integer)
Dim FNum As Integer
Dim txt As String
On Error Resume Next
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNFileMustExist
CommonDialog1.Filter = "SDI Documents *.ay|*.AY|Text Files *.txt|*.TXT|HTML Files *.html|*.HTML|HTM Files *.htm|*.HTM|All files|*.*"
CommonDialog1.ShowOpen
FNum = FreeFile
Open CommonDialog1.FileName For Input As #1
txt = Input(LOF(FNum), #FNum)
Close #FNum
Form1.rtetext.Text = txt
OpenFile = CommonDialog1.FileName
code: ss = FileDateTime(CommonDialog1.FileName) 'date de création
Form3.Label4.Caption = "Date de Création :" & ss
Open (CommonDialog1.FileName) For Binary As #1 'taille de fichier
Form3.Label3.Caption = "Taille :" & LOF(1) & " Byte"
Form3.Hide
Close 1
Exit Sub
End Sub
Private Sub pictur_Click(Index As Integer)
On Error GoTo Bottom
Static Once As Integer 'insert picture
With Form1.CommonDialog2
.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
.Filter = "BMP;JPG FILES(*.BMP;*.JPG)|*.BMP;*.JPG|GIF FILES(*.GIF)|*.GIF|TIF FILES(*.TIF)|*.TIF|All Files(*.*)|*.*"
If Once = 0 Then
.InitDir = App.Path
Once = 1
End If
.ShowOpen
End With
Screen.MousePointer = vbHourglass
Form1.rtetext.OLEObjects.Add , , Form1.CommonDialog2.FileName
Bottom:
Screen.MousePointer = vbDefault
End Sub
Private Sub Qttt_Click(Index As Integer)
shox (True)
End Sub
Private Sub Quitter_Click(Index As Integer)
Dim FNum As Integer
Dim txt As String
On Error Resume Next 'save
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNOverwritePrompt
CommonDialog1.Filter = "SDI Documents *.ay|*.ay|Text Files *.txt|*.TXT|HTML Files *.html|*.HTML|HTM Files *.htm|*.HTM|VBscript Files *.vbs|*.VBS|All files|*.*"
CommonDialog1.ShowSave
FNum = FreeFile
Open CommonDialog1.FileName For Output As #1
Print #FNum, Form1.rtetext.Text
Close #FNum
OpenFile = CommonDialog1.FileName
'-----------------------------ini---------------------------------------------------
Dim nj As Long
Dim FilePath As String
nj = FreeFile()
FilePath = App.Path & "\ini\setting.ini"
Open FilePath For Output As #nj
Print #nj, Text1.Text
Close #nj
Exit Sub
End Sub
Private Sub reck_Click(Index As Integer)
Form2.Show
End Sub
Private Sub s_Click(Index As Integer)
Form2.Show
End Sub
Private Sub rvq_Click(Index As Integer)
Dim FNum As Integer
Dim txt As String
On Error Resume Next
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
CommonDialog1.Filter = "Rich Text Format(*.rtf)|*.rtf|HTML Files(*.htm,*.html,*.asp,*.js,*.css)|*.htm;*.html;*.asp;*.js;*.css|Dat Files(*.Dat)|*.dat|All Files(*.*)|*.*"
CommonDialog1.ShowOpen
FNum = FreeFile
Open CommonDialog1.FileName For Input As #1
txt = Input(LOF(FNum), #FNum)
Close #FNum
Form1.rtetext.Text = txt
OpenFile = CommonDialog1.FileName
code: ss = FileDateTime(CommonDialog1.FileName) 'date de création
Form3.Label4.Caption = "Date de Création :" & ss
Open (CommonDialog1.FileName) For Binary As #1 'taille de fichier
Form3.Label3.Caption = "Taille :" & LOF(1) & " Byte"
Form3.Hide
Close 1
Exit Sub
End Sub
Private Sub Selectionner_Click(Index As Integer)
Form1.rtetext.SelStart = 0
Form1.rtetext.SelLength = Len(Form1.rtetext.Text) 'Selectionner
End Sub
Private Sub UndoT_Timer()
TextTS.SetFocus
SendKeys "(^)z"
Form1.rtetext.Text = TextTS.Text
Form1.rtetext.SetFocus
UndoT.Enabled = False
End Sub
Private Sub Symb_Click(Index As Integer)
frmsm.Show
End Sub
Private Sub Tags_Click(Index As Integer)
RemoveTags (Form1.rtetext.Text)
End Sub
Private Sub tbrEdit_ButtonClick(ByVal Button As MSComctlLib.Button)
If Button.Key = "b" Then
On Error Resume Next
Form1.Data1.Recordset.MoveNext
If Form1.Data1.Recordset.EOF Then 'MoveNext
Form1.Data1.Recordset.MoveFirst
End If
End If
'-----------------------
If Button.Key = "vb" Then
'** Description:
'** Create a new document
Dim frm2 As Form1
Static DocCount As Long '2009
Set frm2 = New Form1
DocCount = DocCount + 1
frm2.Caption = "Documment" & DocCount & "[Création] :" 'caption de nouveau
frm2.Show
End If
'-----------------------
If Button.Key = "Redo" Then
On Error Resume Next
Form1.Data1.Recordset.MovePrevious 'MovePrevious
If Form1.Data1.Recordset.BOF Then
Form1.Data1.Recordset.MoveLast
End If
End If
'--------------------------------------------------------------------------------------
If Button.Key = "t" Then
Form1.Data1.Recordset.Delete 'suprimé persone de base
Form1.Data1.Refresh
End If
'--------------------------------------------------------------------------------------------
If Button.Key = "new" Then
Form1.Data1.Recordset.AddNew 'nouveau base record
Form1.rtetext.Text = ""
End If
'-----------------------------------------------------------------------------------------
If Button.Key = "f" Then
basesave.Show
End If
End Sub
Private Sub tbrFormat_ButtonClick(ByVal Button As MSComctlLib.Button)
If Button.Key = "z" Then
On Error Resume Next
Form1.rtetext.SelItalic = Not Form1.rtetext.SelItalic
End If
'------------------------------------bollet
If Button.Key = "bo" Then
End If
'--------------------------------gras
If Button.Key = "b" Then
On Error Resume Next
Form1.rtetext.SelBold = Not Form1.rtetext.SelBold
End If
'--------------------------------------u----------------------------------------------------------------
If Button.Key = "u" Then
On Error Resume Next
Form1.rtetext.SelBullet = Not Form1.rtetext.SelBullet
End If
'-----------------------------------alignmentleft------------------------------------------------------
If Button.Key = "d" Then
On Error Resume Next
Form1.rtetext.SelAlignment = 1
End If
'--------------------------------alignment droit-----------------------------------------------------
If Button.Key = "j" Then
On Error Resume Next
Form1.rtetext.SelAlignment = 0
End If
'--------------------------------------------------------allinment centrer---------------------------------------
If Button.Key = "C" Then
On Error Resume Next
Form1.rtetext.SelAlignment = 2
End If
'----------------------------------------------------------------------------------------------------------------------------------
'******************************************ayoube2009*****************************************************
'--------------------------------------------gras---------------------------------------------------------------------------------
If Button.Key = "pa" Then
On Error GoTo Bottom
Form1.CommonDialog1.Color = Form1.rtetext.SelColor
Form1.CommonDialog1.Flags = 0 'cdlCCFullOpen
Form1.CommonDialog1.ShowColor
Form1.rtetext.SelColor = Form1.CommonDialog1.Color
Form1.FillColor = Form1.CommonDialog1.Color
Bottom:
End If
'--------------------------------------------find--------------------------------------------------------------------------------------------
If Button.Key = "Find" Then
On Error Resume Next
Form2.Show
End If
'--------------------------------gras--------------------------------------------------------------------------
If Button.Key = "Tel" Then
Frmtel.Show
End If
End Sub
Private Sub tbrStandard_ButtonClick(ByVal Button As MSComctlLib.Button)
If Button.Key = "q" Then
If Form1.WindowState = 0 Then
Form1.WindowState = 2
Else
Form1.WindowState = 0
End If
End If
'----------------------------save-------------------------------------------------------------------------
If Button.Key = "t" Then
Dim FNum As Integer
Dim txt As String
On Error Resume Next
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNOverwritePrompt
CommonDialog1.Filter = "SDI Documents *.ay|*.ay|Text Files *.txt|*.TXT|HTML Files *.html|*.HTML|HTM Files *.htm|*.HTM|VBscript Files *.vbs|*.VBS|All files|*.*"
CommonDialog1.ShowSave
FNum = FreeFile
Open CommonDialog1.FileName For Output As #1
Print #FNum, Form1.rtetext.Text
Close #FNum
OpenFile = CommonDialog1.FileName
'-----------------------------ini-----------------------------------------------------------------------------------------------------
Dim nj As Long
Dim FilePath As String
nj = FreeFile()
FilePath = App.Path & "\ini\setting.ini"
Open FilePath For Output As #nj
Print #nj, Text1.Text
Close #nj
Exit Sub
End If
'--------------------------------------open------------------------------------------------------------------------------------------------------------
If Button.Key = "p" Then
On Error Resume Next
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlOFNFileMustExist
CommonDialog1.Filter = "SDI Documents *.ay|*.AY|Text Files *.txt|*.TXT|HTML Files *.html|*.HTML|HTM Files *.htm|*.HTM|All files|*.*"
CommonDialog1.ShowOpen
FNum = FreeFile
Open CommonDialog1.FileName For Input As #1
txt = Input(LOF(FNum), #FNum)
Close #FNum
Form1.rtetext.Text = txt
OpenFile = CommonDialog1.FileName
Exit Sub
End If
'-----------------------------------------------print-------------------------------------------------------------------------------
If Button.Key = "pr" Then
On Error Resume Next
Call Form1.rtetext.SelPrint(Printer.hdc)
End If
'-------------------------------------------new---------------------------------------------------------------------------------------
If Button.Key = "New" Then
On Error Resume Next
Form1.rtetext.Backcolor = &H80000009
Form1.rtetext.Text = ""
Form1.Caption = "Documment[Création ]:"
Form1.Frame1.Backcolor = &HFFFFFF
End If
'--------------------------------redo-----------------------------------------------------------------------------------------------------------------------
If Button.Key = "Copy" Then
On Error Resume Next
Clipboard.SetText Form1.rtetext.SelText '#############copier#################
End If
If Button.Key = "Cut" Then
On Error Resume Next
Clipboard.Clear
Clipboard.SetText Form1.rtetext.SelText '#############couper#################
Form1.rtetext.SelText = ""
End If
If Button.Key = "Copy" Then
On Error Resume Next
Clipboard.SetText Form1.rtetext.SelText '#############copier#################
End If
If Button.Key = "Paste" Then
On Error Resume Next
Form1.rtetext.SelText = Clipboard.GetText() '#############coller#################
End If
'-----------------------------------------------------------------------------------------------------------------------------------
If Button.Key = "Un" Then
On Error Resume Next
DoEditThing "Undo", Form1.rtetext
End If
'-----------------------------------------------------------------------------------------------------------------------------------
If Button.Key = "Re" Then
On Error Resume Next
DoEditThing "Undo", Form1.rtetext
End If
End Sub
Private Sub tel_Click(Index As Integer)
Frmtel.Show
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Label7.Caption = Val(Label7.Caption) + 1
If Val(Label7.Caption) = 3 Then
Form1.Frame1.Visible = False
Form1.Line2.Visible = False
Timer1.Enabled = False
Label7.Caption = ""
End If
End Sub
Private Sub Timer2_Timer()
Dim pixel As Couleur, CursPos As PointAPI
' Récupère la position de la souris
GetCursorPos CursPos
' Récupère la couleur du pixel pointé par la souris
pixel = CouleurPixel(CursPos.X, CursPos.Y)
' Affiche la couleur dans la PictureBox
' Affiche les coordonnées et la couleur
MDIForm1.Caption = "AyoubePad " & "[Création " & "X:" & CursPos.X & " Y:" & CursPos.Y & "]"
End Sub
Private Sub True_Click(Index As Integer)
Picture1.Visible = True
End Sub
Private Sub txtvertical_Click(Index As Integer)
On Error Resume Next
Dim s As String
For I = 1 To Len(Form1.rtetext.Text) 'txtvertical
s = s & Mid$(Form1.rtetext.Text, I, 1) & vbCrLf
Next
Form1.rtetext.Text = s
End Sub
Private Sub Windows_Click(Index As Integer)
Form2.Show
End Sub
Sub shox(s As Boolean)
On Error Resume Next
If s = True Then
Dim X As Long 'avant le quitter ***2009***
Dim Response
Response = MsgBox("vouler-vous quitter le programe ?", vbOKCancel + vbInformation + vbDefaultButton2, "AyoubPad")
If Response = vbOK Then
End
End If
End If
End Sub
Function RemoveTags(Html As String) As String
Dim buf As String, pos As Integer
On Error Resume Next
pos = InStr(Html, "<")
'check for no tags situation
If pos = 0 Then
RemoveTags = Html
Exit Function
End If
Do
' Add text before the first tag to beffer
buf = buf & left(Html, pos - 1)
' Find end of tag
pos = InStr(Html, ">")
' Remove everythin up to the
' end of the tag from text
If pos = 0 Then Exit Do
Html = Mid(Html, pos + 1)
' Find the start of the next tag
pos = InStr(Html, "<")
If pos = 0 Then Exit Do
Loop While True
RemoveTags = buf
End Function
Private Sub DoEditThing(whatThing As String, onWhat As Object)
On Error Resume Next
Dim Send$
Select Case whatThing
Case "Copy"
Send = "^C"
Case "Cut"
Send = "^X"
Case "Paste"
Send = "^V"
Case "Undo"
Send = "^Z"
End Select
If Len(Send) Then
onWhat.SetFocus
SendKeys Send
End If
End Sub
'-------------------------------------------------------------------------------------------------------------------------------------------------------
' Copyright © Ayoube Errabi 2009-2010 '
Conclusion :
c'est un source gratouit pour tester et ajouter ....................
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.