Solved

Richbox Controls - Apending color text...

Posted on 2003-10-21
10
608 Views
Last Modified: 2007-12-19
Hello, can someone give me an example of how to append color text in a richbox control?  I am using one as a text box, and when opening a file and copying whats in the file into the richtext if there is a specfic word or somthing i would like to make that word a diffrent color.

Thanks

simple Example of what i want done:

dim tempdata
open "myrFile.txt" for input as #1
do
   line input #1, tempdata
   tempdata=replace(tempdata, "RED","makemered")  ' change "makemered" to what ever it takes to make it red
   richtextbox1=richtextbox1 + tempdata
loop until eof(1)
0
Comment
Question by:kwickway
  • 6
  • 2
  • 2
10 Comments
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9591945
with that kind of code you couldn't get it. Load the text first, do a search (don't use replace function, it doesn't works that way) and use .seltext, .sellength anmd so for properties/methods to change the color.
0
 

Author Comment

by:kwickway
ID: 9592019
can you show me an example of how i could get it?  I just want to replace every word "RED" to have the color red.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9592153
Data provided accordingly to points offered.
:)
0
 

Author Comment

by:kwickway
ID: 9592182
im sitting at 0 points left. :(  Is there anything else i can do for you instead?
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9592309
That's not the only problem, i haven't vb isntalled so i cannot test it or wrote sme example code...let me see if i coul dfind any resource...
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9592326
0
 
LVL 16

Accepted Solution

by:
Richie_Simonetti earned 25 total points
ID: 9592339
Two (and take a look at help file!!!)

 
Controls - Rich Text Box

--------------------------------------------------------------------------------

Contents
 Introduction
 Loading and Saving Files
 Formatting Text
 Advanced Formatting
 Tab Stops
 Printing
 Finding and Replacing Text
 View Modes
 Multiple Undo & Redo
 Automatic URL detection

--------------------------------------------------------------------------------

Introduction
The RichTextBox is a additional VB component that comes with Visual Basic Professional and Enterprise Edition. This control allows your program to create formatted text (i.e. bulleted, bold and coloured text) in RTF (Rich Text Format). This file format can then be read by other programs like WordPad and MS Word. It could be use in two main ways.

1) You could program your application like a Word Processor, which would give your user much more freedom than just plain text

2) Use the control in an application where it would be beneficial to the user if you colour certain portions of text. E.G in a HTML editor, where it makes tags one colour, and text another.

<p>THIS IS TEXT </P>

To add the Rich Text Box control to your project click Project|Components. Check the box next to Microsoft Rich TextBox Control. Click OK

   REQUIRED FILES
If you will be installing a program using the RichTextBox control, you need to distribute the following files:
RichTx32.ocx - 200KB
RichEd32.dll - 171KB
 


 


--------------------------------------------------------------------------------

Loading and Saving Files
You can load and save files in 2 different formats; RTF and Plain Text. To load a file use the following syntax:

RichTextBox1.LoadFile FilePath, Format

Where format is either the constant rtfRTF (Rich Text Format) or rtfText (Plain Text).

RichTextBox1.LoadFile "C:\Document1.rtf", rtfRTF

Loads C:\Document1.rtf into RichTextBox1 in RTF

To Save a file use the following syntax:

RichTextBox1.SaveFile FilePath, Format

So

RichTextBox1.SaveFile RichTextBox1.Filename, rtfRTF

This saves the current file in RTF. RichTextBox1.Filename stores the current files path.


--------------------------------------------------------------------------------

Formatting Text
To make selected text bold, underlined, italic or strikethrough you can use the following code:

Statement Action
RichTextBox1.SelBold = True Makes the selected text Bold
RichTextBox1.SelItalic = True Makes the selected text Italic
RichTextBox1.SelUnderline = True Makes the selected text Underlined
RichTextBox1.SelStrikeThru = True Makes the selected text Strikethrough

To change the alignment, simply use this syntax:

RichTextBox1.SelAlignment = Alignment

Where alignment is one of the following constants:

Constant Alignment
vbRight Right
vbLeft Left
vbCenter Centre

So, the following code will set make the selected text underlined, and aligned to the right.

RichTextBox1.SelAlignment = vbRight
RichTextBox1.SelUnderline = True


--------------------------------------------------------------------------------

Advanced Formatting
Apart from making text bold, underlined, italic or strikethrough you can also use bullets, tab stops and left and right indents. Of these, tab stops are the most complicated and will be covered in another section. Note: For any of these examples, set the Scale Mode property on the Form that the text box is contained to Millimetres, or adjust the values shown in any examples on this page.

Statement Action
RichTextBox1.SelBullet = True Makes the selected text bulleted
RichTextBox1.BulletIndent = 10 Sets the distance between the bullet and the text to 10 (applies to all)
RichTextBox1.RightMargin = 100 Sets the right margin of all the text in the Rich Text Box to 100.
RichTextBox1.SelRightIndent = 100 Sets the right indent of all the selected text in the Rich Text Box to 100 (measured from the left).
RichTextBox1.SelIndent = 100 Sets the selected text left indent to 100

So, the following code will set make the selected text bulleted, indents by 10 mm and sets the right margin to 100 mm

' Set the forms scale mode
Me.ScaleMode = vbMillimeters
' Set the bullet
RichTextBox1.SelBullet = True
' Set the indent
RichTextBox1.SelIndent = 10
' Set the right margin
RichTextBox1.RightMargin = 100


--------------------------------------------------------------------------------

Tab Stops
Tab Stops allow you to specify the intervals the cursor moves to when you press the tab key. (Try right clicking on the ruler in word to see an example). The Rich Text Box supports this, but you must note that in order for it to work, the tab values have to be in order. For this I use a list box. The current tabs are loaded into the list box, and can be removed or added and when the dialog is closed, the contents of the list box loaded back into the SelTabs property. Note that the property name is SelTabs, ie that they are not applied to the whole document.

Create a form called frmMain with a rich text box on it called txtText. Then create a form named frmTabStops, and add the following controls:

Control Type Name Properties
Combo Box cboTabs Style = Simple Combo; Sorted = False
Command Button cmdOK  
Command Button cmdAdd  
Command Button cmdRemove  

I use the following code:

' Form load code
Private Sub Form_Load()
    On Error Resume Next
    ' Add the tab stops
    For i = 0 To frmMain.txtText.SelTabCount - 1
        ' Add the item to the list box
        cboTabs.AddItem CInt((frmMain.txtText.SelTabs(i) * 100) / 100#)
    Next
    cboTabs.ListIndex = 0
End Sub

' Add tab code
Public Sub cmdAdd_Click()
    Dim gItemFound As Boolean
    gItemFound = False
    ' Add new value
    For i = 0 To cboTabs.ListCount - 1
        ' Is the current item more than
        ' new one?
        If Val(cboTabs.List(i)) > Val(cboTabs.Text) Then
            ' Yes it is, add the new
            ' item here
            cboTabs.AddItem cboTabs.Text, i
            ' select this item
            cboTabs.ListIndex = i
            ' we have put it in
            gItemFound = True
            Exit For
        End If
Next
If gItemFound = False Then
    ' No item found that is greater
    ' put the new item at bottom
    cboTabs.AddItem cboTabs.Text, cboTabs.ListCount
    ' select the item
    cboTabs.ListIndex = cboTabs.ListCount - 1
End If

End Sub

' Remove tab code
Private Sub cmdRemove_Click()
    ' Are you sure?
    If MsgBox("Remove current tab stop?", vbYesNo + vbExclamation) = vbNo Then Exit Sub
    cboTabs.RemoveItem (cboTabs.ListIndex)
End Sub

' OK code
Public Sub cmdOK_Click()
    ' Update sel tabs
    frmMain.txtText.SelTabCount = cboTabs.ListCount
    For i = 0 To cboTabs.ListCount - 1
        ' Add the sel tab
        frmMain.txtText.SelTabs(i) = cboTabs.List(i)
    Next
    Unload Me
End Sub


--------------------------------------------------------------------------------

Printing
It is very easy to print from the RichTextbox. Use the following statement:

fMainForm.ActiveForm.txtText.SelPrint (Printer.hDC)

However, it will send the text to the printer without any margins, so the text will be printed right on the edge of the sheet. There is a microsoft support page which shows you how to set up the RichText box for WYSIWYG (What you see is what you get) printing, along with printer margins. Click here to see that article.


--------------------------------------------------------------------------------

Finding and Replacing Text
You can find text in the Rich Text box control very easily using the Find Method. The Find Method uses the following syntax:

RichTextBox1.Find FindString, StartPos, EndPos, Options

FindString is the Text to fine. StartPos is an integer representing the start position. To start from the beginning of the document this would be set to 0. EndPos is an integer representing the end position. If this is left blank then it is set the the length of the document. Options contains one or more of the following flags:

Flag Action
rtfNoHighlight Don't highlight selection
rtfWholeWord Only searches for the whole word
rtfMatchCase Matches the case of the FindString

The following code searches RichTextBox1 for the Text contained in Text1. It searched for the whole word only:

Sub Command1_Click()
    SearchText = Text1.Text
    gOptions = rtfWholeWord
    Result = RichTextBox1.Find (SearchText,0, ,gOptions)

    If Result = -1 Then
        Msgbox "Text not found"
    Else
        Msgbox "Text Found"
    End If
End Sub

Once you have found the text, you can change it using the SelText property. The following code will search the whole of RTB1 for the text contained in txtFind, and then will replace that text with the text in txtReplace. It uses Match Case and Whole Word Only.

' Set the options
gOptions = rtfWholeWord + rtfMatchCase
' Set the counter to 0
gCount = 0
Do
    If gDoc.Find(txtFind.Text, RTB1.SelStart + RTB1.SelLength, , goptions) = -1 Then
        ' No more matches
        If gCount = 0 Then
            ' First time round, no matches found
            MsgBox "Unable to find '" & txtFind.Text & "' in specified range"
        Else
            ' Matches found
            MsgBox "The specified region has been searched. " & gCount & _
                    " replacements have been made"
        End If
        cmdFind.Caption = "&Find"
        Exit Do
    Else
        ' Increment replace count
        gCount = gCount + 1
        ' Replace the selected text with the replace text
        gDoc.SelText = txtReplace.Text
    End If
Loop


--------------------------------------------------------------------------------

Inserting Files and Images
The RichTextBox supports inserting both Images and Files. The following image formats are supported:

Bitmap (*.bmp)
Gif (*.gif)
JPEG (*.jpg)

It also supports

Word Documents (*.doc)
Excel Spreadsheets (*.xls)

Any other file will be displayed as an icon.

The following code shows a dialog to select a file, and then inserts the file into the RichTextBox

Sub Command1_Click()
    With CommonDialog1
        .CancelError = True
        .Filter = "All Files *.*|*.*"
        On Error Resume Next
        ' Show open dialog
        .ShowOpen
        If Err Then Exit Sub
    End With
    On Error Resume Next
    ' Attemt to add OLE Object
    RichTextBox1.OLEObjects.Add , , CommonDialog1.Filename
    ' Check to see if an error has occured
    If Err = 462 Then
        MsgBox "Error importing file, may be low on memory"
    End If
End Sub


--------------------------------------------------------------------------------

Adding View modes
The short code below allows you to easily add view modes to your RichTextBox code. This supports:
Default (ercDefault) '// WordWrap
NoWrap (ercWordWrap)
WYSIWYG (ercWYSIWYG) '// What you see is what you get.

To change the WYSIWYG settings (such as page orientation and paper size), simply change the printer properties, and call SetViewMode again. This will then allow for pages to be set to landscape, or an A5 page. Add this code to a module

Public Const EM_SETTARGETDEVICE = (WM_USER + 72)

Public 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


'// View Types
Public Enum ERECViewModes
   ercDefault = 0
   ercWordWrap = 1
   ercWYSIWYG = 2
End Enum

'// Sets the View Mode
Private Sub SetViewMode(ByVal eViewMode As ERECViewModes)
   Select Case eViewMode
   Case ercWYSIWYG
      On Error Resume Next
      SendMessageLong frmMain.rtfText.hWnd, EM_SETTARGETDEVICE, Printer.hDC, Printer.Width
   Case ercWordWrap
      SendMessageLong frmMain.rtfText.hWnd, EM_SETTARGETDEVICE, 0, 0
   Case ercDefault
      SendMessageLong frmMain.rtfText.hWnd, EM_SETTARGETDEVICE, 0, 1
   End Select
End Sub

This code has been adapted from VB Accelerator's RichEdit control.

 


--------------------------------------------------------------------------------

Adding Multiple Undo & Redo
The RichTextBox actually supports multiple undo and redo. However, this functionality is hidden from VB programmers. In order to be able to use the undo and redo facilities, you need to add the following code.

Add this code to the Form_Load() event of the form that contains the RichTextBox control. We are calling the RichTextBox rtfText

Dim lStyle As Long
'// required to 'reveal' multiple undo
'// set rich text box style
lStyle = TM_RICHTEXT Or TM_MULTILEVELUNDO Or TM_MULTICODEPAGE
SendMessageLong rtfText.hwnd, EM_SETTEXTMODE, lStyle, 0

Then, add the code below. This code also adds cut/copy/paste/clear functionality, and expects the following menu items:


Menu Name Caption
mnuEdit &Edit
mnuEditUndo &Undo
mnuEditRedo &Redo
mnuEditCut Cu&t
mnuEditCopy &Copy
mnuEditPaste &Paste
mnuEditClear C&lear

Call the UpdateItems procedure in the mnuEdit_Click() event. This procedure updates the menu items.

Public Property Get UndoType() As ERECUndoTypeConstants
    UndoType = SendMessageLong(rtfText.hWnd, EM_GETUNDONAME, 0, 0)
End Property
Public Property Get RedoType() As ERECUndoTypeConstants
    RedoType = SendMessageLong(rtfText.hWnd, EM_GETREDONAME, 0, 0)
End Property
Public Property Get CanPaste() As Boolean
   CanPaste = SendMessageLong(rtfText.hWnd, EM_CANPASTE, 0, 0)
End Property
Public Property Get CanCopy() As Boolean
   If rtfText.SelLength < 0 Then
      CanCopy = True
   End If
End Property
Public Property Get CanUndo() As Boolean
    CanUndo = SendMessageLong(rtfText.hWnd, EM_CANUNDO, 0, 0)
End Property
Public Property Get CanRedo() As Boolean
    CanRedo = SendMessageLong(rtfText.hWnd, EM_CANREDO, 0, 0)
End Property

'///////////////////////////////////////////////////////
'// Methods
Public Sub Undo()
    SendMessageLong rtfText.hWnd, EM_UNDO, 0, 0
End Sub
Public Sub Redo()
    SendMessageLong rtfText.hWnd, EM_REDO, 0, 0
End Sub
Public Sub Cut()
   SendMessageLong rtfText.hWnd, WM_CUT, 0, 0
End Sub
Public Sub Copy()
   SendMessageLong rtfText.hWnd, WM_COPY, 0, 0
End Sub
Public Sub Paste()
   SendMessageLong rtfText.hWnd, WM_PASTE, 0, 0
End Sub
Public Sub Clear()
   rtfText.SelText = Empty
End Sub
Public Sub UpdateItems()
    Dim bCanUndo As Boolean
    '// Undo/Redo options:
    bCanUndo = CanUndo
    mnuEditUndo.Enabled = bCanUndo
    '// Set Undo Text
    If (bCanUndo) Then
        mnuEditUndo.Caption = "&Undo " & TranslateUndoType(UndoType)
    Else
        mnuEditUndo.Caption = "&Undo"
    End If
    '// Set Redo Text
    bCanUndo = CanRedo
    If (bCanUndo) Then
        mnuEditRedo.Caption = "&Redo " & TranslateUndoType(RedoType)
    Else
        mnuEditRedo.Caption = "&Redo"
    End If
    mnuEditRedo.Enabled = bCanUndo
    tbToolBar.Buttons("Redo").Enabled = bCanUndo
    '// Cut/Copy/Paste/Clear options
    mnuEditCut.Enabled = CanCopy
    mnuEditCopy.Enabled = CanCopy
    mnuEditPaste.Enabled = CanPaste
    mnuEditClear.Enabled = CanCopy
End Sub
'// Returns the undo/redo type
Private Function TranslateUndoType(ByVal eType As ERECUndoTypeConstants) As String
   Select Case eType
   Case ercUID_UNKNOWN
      TranslateUndoType = "Last Action"
   Case ercUID_TYPING
      TranslateUndoType = "Typing"
   Case ercUID_PASTE
      TranslateUndoType = "Paste"
   Case ercUID_DRAGDROP
      TranslateUndoType = "Drag Drop"
   Case ercUID_DELETE
      TranslateUndoType = "Delete"
   Case ercUID_CUT
      TranslateUndoType = "Cut"
   End Select
End Function

Then, add this code to a module

'// View Types
Public Enum ERECViewModes
    ercDefault = 0
    ercWordWrap = 1
    ercWYSIWYG = 2
End Enum
'// Undo Types
Public Enum ERECUndoTypeConstants
    ercUID_UNKNOWN = 0
    ercUID_TYPING = 1
    ercUID_DELETE = 2
    ercUID_DRAGDROP = 3
    ercUID_CUT = 4
    ercUID_PASTE = 5
End Enum
'// Text Modes
Public Enum TextMode
    TM_PLAINTEXT = 1
    TM_RICHTEXT = 2 ' /* default behavior */
    TM_SINGLELEVELUNDO = 4
    TM_MULTILEVELUNDO = 8 ' /* default behavior */
    TM_SINGLECODEPAGE = 16
    TM_MULTICODEPAGE = 32 ' /* default behavior */
End Enum

Public Const WM_USER = &H400
Public Const EM_SETTEXTMODE = (WM_USER + 89)
Public Const EM_UNDO = &HC7
Public Const EM_REDO = (WM_USER + 84)
Public Const EM_CANPASTE = (WM_USER + 50)
Public Const EM_CANUNDO = &HC6&
Public Const EM_CANREDO = (WM_USER + 85)
Public Const EM_GETUNDONAME = (WM_USER + 86)
Public Const EM_GETREDONAME = (WM_USER + 87)

Public 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
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long


And that's it! What you thought is impossible, is actually possible in a few lines of code. Of course, it would have been much easier if Microsoft had provided these functions for VB programmers anyway. This code has been adapted from VB Accelerator's RichEdit control.


--------------------------------------------------------------------------------

Automatic URL detection
The code below adds an automatic URL detection facility to the RichTextBox (which again, is actually built into it). The code uses subclassing, and the SSUBTMR.DLL (only 27K) file so that VB does not crash when you try to debug the program! The richtextbox is named rtfText, and you need a label called lblStatus.


Private m_bAutoURLDetect As Boolean
'// subclassing implementation
Implements ISubclass
Private m_emr As EMsgResponse

Private Sub rtfText_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    lblStatus = ""
End Sub

Private Sub Form_Load()
    AttachMessages
    '// auto detect urls
    AutoURLDetect = True
    Form_Resize
End Sub
Private Sub Form_Unload(Cancel As Integer)
    '// unsubclass!
    DetachMessages
End Sub
Private Sub Form_Resize()
    On Error Resume Next
    rtfText.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

'///////////////////////////////////////////////////////
'// Subclassing
'// Required for automatic url detection
'///////////////////////////////////////////////////////

Private Sub AttachMessages()
Dim dwMask As Long
    AttachMessage Me, hwnd, WM_NOTIFY
    '// we need to detect the link over messages
    '// by setting enm_link, however, this then
    '// cancels any other messages (such as the
    '// change event, so we need to specify
    '// these too.
    ' Key And Mouse Events
    dwMask = ENM_KEYEVENTS Or ENM_MOUSEEVENTS
    ' Selection change
    dwMask = dwMask Or ENM_SELCHANGE
    ' Update
    dwMask = dwMask Or ENM_DROPFILES
    ' Scrolling
    dwMask = dwMask Or ENM_SCROLL
    ' Update:
    dwMask = dwMask Or ENM_UPDATE
    ' Change:
    dwMask = dwMask Or ENM_CHANGE
    dwMask = dwMask Or ENM_LINK
    SendMessageLong rtfText.hwnd, EM_SETEVENTMASK, 0, dwMask
End Sub
Private Sub DetachMessages()
    DetachMessage Me, hwnd, WM_NOTIFY
End Sub
Private Function ISubclass_WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tNMH As NMHDR_RICHEDIT
Dim tEN As ENLINK
   Select Case iMsg

   Case WM_NOTIFY
      CopyMemory tNMH, ByVal lParam, Len(tNMH)
      If (tNMH.hwndFrom = rtfText.hwnd) Then
         Select Case tNMH.code
         Case EN_LINK
            CopyMemory tEN, ByVal lParam, Len(tEN)
            LinkOver tEN.msg, tEN.chrg.cpMin, tEN.chrg.cpMax - tEN.chrg.cpMin
         End Select
      End If
   End Select
End Function
Private Property Let ISubclass_MsgResponse(ByVal RHS As SSubTimer.EMsgResponse)
    '// this sub has to exist whether you like it or not
End Property
Private Property Get ISubclass_MsgResponse() As SSubTimer.EMsgResponse
    ISubclass_MsgResponse = emrPostProcess
End Property
'///////////////////////////////////////////////////////
'// URL detection
Public Property Let AutoURLDetect(ByVal bState As Boolean)
    m_bAutoURLDetect = bState
    SendMessageLong rtfText.hwnd, EM_AUTOURLDETECT, Abs(bState), 0
End Property
Public Property Get AutoURLDetect() As Boolean
   AutoURLDetect = m_bAutoURLDetect
End Property

'// occurs when the mouse is moved over a link, or it is clicked
Public Sub LinkOver(ByVal iType As ERECLinkEventTypeCOnstants, ByVal lStart As Long, ByVal lLength As Long)
    Dim strText As String
    strText = Mid$(rtfText.Text, lStart + 1, lLength + 1)
    If (iType = ercLButtonUp) Then
        If ShellExecute(hwnd, vbNullString, strText, vbNullString, vbNullString, vbNormalFocus) = 2 Then
            MsgBox "Link Failed", vbExclamation
        End If
    Else
        'lblStatus = "LinkOver: " & strText
    End If
End Sub


Then, add this code to a module

Public Type CHARRANGE
    cpMin As Long
    cpMax As Long
End Type
'// notification structures
Public Type NMHDR_RICHEDIT
    hwndFrom As Long
    wPad1 As Integer
    idfrom As Integer
    code As Integer
    wPad2 As Integer
End Type

Public Type ENLINK
    NMHDR As NMHDR_RICHEDIT
    msg As Integer
    wPad1 As Integer
    wParam As Integer
    wPad2 As Integer
    lParam As Integer
    chrg As CHARRANGE
End Type
'// events and messages
Public Const ENM_LINK = &H4000000
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_SETCURSOR = &H20
Public Const WM_MOUSEMOVE = &H200

Public Enum ERECLinkEventTypeCOnstants
   ercLButtonDblClick = WM_LBUTTONDBLCLK
   ercLButtonDown = WM_LBUTTONDOWN
   ercLButtonUp = WM_LBUTTONUP
   ercMouseMove = WM_MOUSEMOVE
   ercRButtonDblClick = WM_RBUTTONDBLCLK
   ercRButtonDown = WM_RBUTTONDOWN
   ercRBUttonUp = WM_RBUTTONUP
   ercSetCursor = WM_SETCURSOR
End Enum

Public Const WM_USER = &H400
Public Const EM_SETEVENTMASK = (WM_USER + 69)

Public Const WM_NOTIFY = &H4E
Public Const EN_LINK = &H70B&

'// Event Masks
Public Const ENM_NONE = &H0
Public Const ENM_CHANGE = &H1
Public Const ENM_UPDATE = &H2
Public Const ENM_SCROLL = &H4
Public Const ENM_KEYEVENTS = &H10000
Public Const ENM_MOUSEEVENTS = &H20000
Public Const ENM_REQUESTRESIZE = &H40000
Public Const ENM_SELCHANGE = &H80000
Public Const ENM_DROPFILES = &H100000
Public Const ENM_PROTECTED = &H200000
Public Const ENM_CORRECTTEXT = &H400000               ' /* PenWin specific */
Public Const ENM_SCROLLEVENTS = &H8
Public Const ENM_DRAGDROPDONE = &H10

Public Const EM_SETTARGETDEVICE = (WM_USER + 72)
Public Const EM_SETTEXTMODE = (WM_USER + 89)

Public Const EM_AUTOURLDETECT = (WM_USER + 91)
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)

Public 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
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


That's it! This code has been adapted from VB Accelerator's RichEdit control.

 
 

--------------------------------------------------------------------------------

Back to Top

This is from VB web, i haven't the url, sorry.
0
 
LVL 16

Expert Comment

by:Richie_Simonetti
ID: 9592349
0
 

Expert Comment

by:Banu1973
ID: 14255619
Hi All,

I need to append data from One excel file to another.

I have Supplier Master data base as given below:

Supplier No. Supplier Name Invoice No.  Amount
12345          ABCD
0
 

Expert Comment

by:Banu1973
ID: 14255639
Hi All,

I need to append data from One excel file to another.

I have Supplier Master data base as given below:

Supplier No. Supplier Name Invoice No.  Amount
12345          ABCD                12A           400
12346          BCDE                 13A          700
12345          ABCD                 13            800
12346          BCDE                  14A         890
12347          CDEF                  11           90
12347          BBBB                  12            80

I need to copy the data of 12345 to 12345.xls as given below
Supplier No. Supplier Name Invoice No.  Amount
12345          ABCD                12A           400
12345          ABCD                 13            800

Likewise, I need to do for 1000 Suppliers..Please help me...

0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now