vb如何做剪切、复制、粘贴按钮

获得文字直接用

Clipboard.GetText

获得图片可以用

Clipboard.GetData

设置文字直接用

Clipboard.SetText

设置图片可以用

Clipboard.SetData

清空

Clipboard.Clear

检测剪贴板中的内容

Clipboard.GetFormat(1)

返回True则文字

返回False则其他

不用剪切板可以这样

Dim s

Private Sub Command1_Click()

s = Text1.Text

Text1.Text = ""

End Sub

Private Sub Command2_Click()

s = Text1.Text

End Sub

Private Sub Command3_Click()

Text1.Text = Text1.Text + s

End Sub

Private Sub Form_Load()

Command1.Caption = "剪切"

Command2.Caption = "复制"

Command3.Caption = "粘贴"

End Sub

告诉你个诀窍，新建一个VB应用程序向导程序。可以从中获取不少VB给出的标准代码，略作修改就能满足自己编写程序的代码用。实现拿来就能用。

菜单部分：

代码部分：

Option Explicit

    Private 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

    Const EM_UNDO = &HC7

    Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

Private Sub MDIForm_Load()

    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)

    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)

    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)

    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)

    LoadNewDoc

End Sub

Private Sub LoadNewDoc()

    Static lDocumentCount As Long

    Dim frmD As frmDocument

    lDocumentCount = lDocumentCount + 1

    Set frmD = New frmDocument

    frmD.Caption = "Document " & lDocumentCount

    frmD.Show

End Sub

Private Sub MDIForm_Unload(Cancel As Integer)

    If Me.WindowState <> vbMinimized Then

        SaveSetting App.Title, "Settings", "MainLeft", Me.Left

        SaveSetting App.Title, "Settings", "MainTop", Me.Top

        SaveSetting App.Title, "Settings", "MainWidth", Me.Width

        SaveSetting App.Title, "Settings", "MainHeight", Me.Height

    End If

End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button)

    On Error Resume Next

    Select Case Button.Key

        Case "新建"

            LoadNewDoc

        Case "打开"

            mnuFileOpen_Click

        Case "保存"

            mnuFileSave_Click

        Case "打印"

            mnuFilePrint_Click

        Case "剪切"

            mnuEditCut_Click

        Case "复制"

            mnuEditCopy_Click

        Case "粘贴"

            mnuEditPaste_Click

        Case "粗体"

            ActiveForm.rtfText.SelBold = Not ActiveForm.rtfText.SelBold

            Button.Value = IIf(ActiveForm.rtfText.SelBold, tbrPressed, tbrUnpressed)

        Case "斜体"

            ActiveForm.rtfText.SelItalic = Not ActiveForm.rtfText.SelItalic

            Button.Value = IIf(ActiveForm.rtfText.SelItalic, tbrPressed, tbrUnpressed)

        Case "下划线"

            ActiveForm.rtfText.SelUnderline = Not ActiveForm.rtfText.SelUnderline

            Button.Value = IIf(ActiveForm.rtfText.SelUnderline, tbrPressed, tbrUnpressed)

        Case "左对齐"

            ActiveForm.rtfText.SelAlignment = rtfLeft

        Case "置中"

            ActiveForm.rtfText.SelAlignment = rtfCenter

        Case "右对齐"

            ActiveForm.rtfText.SelAlignment = rtfRight

    End Select

End Sub

Private Sub mnuHelpAbout_Click()

    MsgBox "版本 " & App.Major & "." & App.Minor & "." & App.Revision

End Sub

Private Sub mnuHelpSearchForHelpOn_Click()

    Dim nRet As Integer

    '如果这个工程没有帮助文件，显示消息给用户

    '可以在“工程属性”对话框中为应用程序设置帮助文件

    If Len(App.HelpFile) = 0 Then

        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption

    Else

    On Error Resume Next

        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)

        If Err Then

            MsgBox Err.Description

        End If

    End If

End Sub

Private Sub mnuHelpContents_Click()

    Dim nRet As Integer

    '如果这个工程没有帮助文件，显示消息给用户

    '可以在“工程属性”对话框中为应用程序设置帮助文件

    If Len(App.HelpFile) = 0 Then

        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption

    Else

        On Error Resume Next

        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)

        If Err Then

            MsgBox Err.Description

        End If

    End If

End Sub

Private Sub mnuWindowArrangeIcons_Click()

    Me.Arrange vbArrangeIcons

End Sub

Private Sub mnuWindowTileVertical_Click()

    Me.Arrange vbTileVertical

End Sub

Private Sub mnuWindowTileHorizontal_Click()

    Me.Arrange vbTileHorizontal

End Sub

Private Sub mnuWindowCascade_Click()

    Me.Arrange vbCascade

End Sub

Private Sub mnuWindowNewWindow_Click()

    LoadNewDoc

End Sub

Private Sub mnuViewWebBrowser_Click()

    '应做:添加 'mnuViewWebBrowser_Click' 代码。

    MsgBox "添加 'mnuViewWebBrowser_Click' 代码。"

End Sub

Private Sub mnuViewOptions_Click()

    '应做:添加 'mnuViewOptions_Click' 代码。

    MsgBox "添加 'mnuViewOptions_Click' 代码。"

End Sub

Private Sub mnuViewRefresh_Click()

    '应做:添加 'mnuViewRefresh_Click' 代码。

    MsgBox "添加 'mnuViewRefresh_Click' 代码。"

End Sub

Private Sub mnuViewStatusBar_Click()

    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked

    sbStatusBar.Visible = mnuViewStatusBar.Checked

End Sub

Private Sub mnuViewToolbar_Click()

    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked

    tbToolBar.Visible = mnuViewToolbar.Checked

End Sub

Private Sub mnuEditPasteSpecial_Click()

    '应做:添加 'mnuEditPasteSpecial_Click' 代码。

    MsgBox "添加 'mnuEditPasteSpecial_Click' 代码。"

End Sub

Private Sub mnuEditPaste_Click()

    On Error Resume Next

    ActiveForm.rtfText.SelRTF = Clipboard.GetText

End Sub

Private Sub mnuEditCopy_Click()

    On Error Resume Next

    Clipboard.SetText ActiveForm.rtfText.SelRTF

End Sub

Private Sub mnuEditCut_Click()

    On Error Resume Next

    Clipboard.SetText ActiveForm.rtfText.SelRTF

    ActiveForm.rtfText.SelText = vbNullString

End Sub

Private Sub mnuEditUndo_Click()

    '应做:添加 'mnuEditUndo_Click' 代码。

    MsgBox "添加 'mnuEditUndo_Click' 代码。"

End Sub

Private Sub mnuFileExit_Click()

    '卸载窗体

    Unload Me

End Sub

Private Sub mnuFileSend_Click()

    '应做:添加 'mnuFileSend_Click' 代码。

    MsgBox "添加 'mnuFileSend_Click' 代码。"

End Sub

Private Sub mnuFilePrint_Click()

    On Error Resume Next

    If ActiveForm Is Nothing Then Exit Sub

    

    With dlgCommonDialog

        .DialogTitle = "Print"

        .CancelError = True

        .Flags = cdlPDReturnDC + cdlPDNoPageNums

        If ActiveForm.rtfText.SelLength = 0 Then

            .Flags = .Flags + cdlPDAllPages

        Else

            .Flags = .Flags + cdlPDSelection

        End If

        .ShowPrinter

        If Err <> MSComDlg.cdlCancel Then

            ActiveForm.rtfText.SelPrint .hDC

        End If

    End With

End Sub

Private Sub mnuFilePrintPreview_Click()

    '应做:添加 'mnuFilePrintPreview_Click' 代码。

    MsgBox "添加 'mnuFilePrintPreview_Click' 代码。"

End Sub

Private Sub mnuFilePageSetup_Click()

    On Error Resume Next

    With dlgCommonDialog

        .DialogTitle = "页面设置"

        .CancelError = True

        .ShowPrinter

    End With

End Sub

Private Sub mnuFileProperties_Click()

    '应做:添加 'mnuFileProperties_Click' 代码。

    MsgBox "添加 'mnuFileProperties_Click' 代码。"

End Sub

Private Sub mnuFileSaveAll_Click()

    '应做:添加 'mnuFileSaveAll_Click' 代码。

    MsgBox "添加 'mnuFileSaveAll_Click' 代码。"

End Sub

Private Sub mnuFileSaveAs_Click()

    Dim sFile As String

    

    If ActiveForm Is Nothing Then Exit Sub

    

    With dlgCommonDialog

        .DialogTitle = "另存为"

        .CancelError = False

        'ToDo: 设置 common dialog 控件的标志和属性

        .Filter = "所有文件 (*.*)|*.*"

        .ShowSave

        If Len(.FileName) = 0 Then

            Exit Sub

        End If

        sFile = .FileName

    End With

    ActiveForm.Caption = sFile

    ActiveForm.rtfText.SaveFile sFile

End Sub

Private Sub mnuFileSave_Click()

    Dim sFile As String

    If Left$(ActiveForm.Caption, 8) = "Document" Then

        With dlgCommonDialog

            .DialogTitle = "保存"

            .CancelError = False

            'ToDo: 设置 common dialog 控件的标志和属性

            .Filter = "所有文件 (*.*)|*.*"

            .ShowSave

            If Len(.FileName) = 0 Then

                Exit Sub

            End If

            sFile = .FileName

        End With

        ActiveForm.rtfText.SaveFile sFile

    Else

        sFile = ActiveForm.Caption

        ActiveForm.rtfText.SaveFile sFile

    End If

End Sub

Private Sub mnuFileClose_Click()

    '应做:添加 'mnuFileClose_Click' 代码。

    MsgBox "添加 'mnuFileClose_Click' 代码。"

End Sub

Private Sub mnuFileOpen_Click()

    Dim sFile As String

    If ActiveForm Is Nothing Then LoadNewDoc

    

    With dlgCommonDialog

        .DialogTitle = "打开"

        .CancelError = False

        'ToDo: 设置 common dialog 控件的标志和属性

        .Filter = "所有文件 (*.*)|*.*"

        .ShowOpen

        If Len(.FileName) = 0 Then

            Exit Sub

        End If

        sFile = .FileName

    End With

    ActiveForm.rtfText.LoadFile sFile

    ActiveForm.Caption = sFile

End Sub

Private Sub mnuFileNew_Click()

    LoadNewDoc

End Sub

以前做过个记事本，里边有类似的功能……

VERSION 5.00

Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0""RICHTX32.OCX"

Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0""COMDLG32.OCX"

Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0""MSCOMCTL.OCX"

Begin VB.Form frmnotebook

Appearance = 0 'Flat

BackColor = &H80000005&

Caption = "notebook"

ClientHeight= 7845

ClientLeft = 225

ClientTop = 855

ClientWidth = 10650

Icon= "Form1.frx":0000

LinkTopic = "Form1"

ScaleHeight = 7845

ScaleWidth = 10650

StartUpPosition = 3 '窗口缺省

Begin RichTextLib.RichTextBox RT1

Height = 7935

Left= 0

TabIndex= 1

Top = 0

Width = 10695

_ExtentX= 18865

_ExtentY= 13996

_Version= 393217

ScrollBars = 2

TextRTF = $"Form1.frx":0442

End

Begin MSComctlLib.StatusBar StatusBar1

Align = 2 'Align Bottom

Height = 615

Left= 0

TabIndex= 0

Top = 7230

Width = 10650

_ExtentX= 18785

_ExtentY= 1085

Style = 1

_Version= 393216

BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}

NumPanels = 1

BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}

Text= "作者：MJ"

TextSave= "作者：MJ"

EndProperty

EndProperty

End

Begin MSComDlg.CommonDialog CM1

Left= 5520

Top = 6480

_ExtentX= 847

_ExtentY= 847

_Version= 393216

End

Begin VB.Menu file

Caption = "文件(F)"

Begin VB.Menu new

Caption = "新建(N)"

Shortcut= ^N

End

Begin VB.Menu line1

Caption = "-"

End

Begin VB.Menu Open

Caption = "打开(O)..."

Shortcut= ^O

End

Begin VB.Menu save

Caption = "保存(S)"

Shortcut= ^S

End

Begin VB.Menu as

Caption = "另存为(A)..."

End

Begin VB.Menu line2

Caption = "-"

End

Begin VB.Menu pageset

Caption = "页面设置(U)..."

End

Begin VB.Menu print

Caption = "打印(P)..."

Shortcut= ^P

End

Begin VB.Menu line3

Caption = "-"

End

Begin VB.Menu quit

Caption = "退出(X)"

End

End

Begin VB.Menu edit

Caption = "编辑(E)"

Begin VB.Menu repeal

Caption = "撤销(U)"

Shortcut= ^Z

End

Begin VB.Menu line4

Caption = "-"

End

Begin VB.Menu cut

Caption = "剪切(T)"

Shortcut= ^X

End

Begin VB.Menu copy

Caption = "复制(C)"

Shortcut= ^C

End

Begin VB.Menu plaster

Caption = "粘贴(P)"

Shortcut= ^V

End

Begin VB.Menu delete

Caption = "删除(L)"

Shortcut= {DEL}

End

Begin VB.Menu line5

Caption = "-"

End

Begin VB.Menu find

Caption = "查找(F)..."

Shortcut= ^F

End

Begin VB.Menu next

Caption = "查找下一个(N)"

Shortcut= {F3}

End

Begin VB.Menu replace

Caption = "替换(R)..."

Shortcut= ^H

End

Begin VB.Menu goto

Caption = "转到(G)..."

Shortcut= ^G

End

Begin VB.Menu line6

Caption = "-"

End

Begin VB.Menu all

Caption = "全选(A)"

Shortcut= ^A

End

Begin VB.Menu date

Caption = "日期(D)"

Shortcut= {F5}

End

End

Begin VB.Menu format

Caption = "格式(O)"

Index = 0

Begin VB.Menu automatic

Caption = "自动换行(W)"

Checked = -1 'True

End

Begin VB.Menu fontname

Caption = "字体(F)..."

End

Begin VB.Menu color

Caption = "颜色(c)"

End

End

Begin VB.Menu vhelp

Caption = "查看(V)"

Begin VB.Menu state

Caption = "状态栏(S)"

End

End

Begin VB.Menu view

Caption = "帮助(H)"

Begin VB.Menu help

Caption = "查看帮助(H)"

End

Begin VB.Menu line7

Caption = "-"

End

Begin VB.Menu about

Caption = "关于记事本(A)"

End

End

End

Attribute VB_Name = "frmnotebook"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

'定义宽高的全局变量

Dim x As Integer, y As Integer

Private Sub about_Click()

frmAbout.Show

End Sub

Private Sub all_Click()

'设置全选

RT1.SelStart = 0

RT1.SelLength = Len(RT1.Text)

End Sub

Private Sub as_Click()

'设置另存（位置）

CM1.ShowSave

Call RT1.SaveFile(CM1.FileName)

'richboxtext 保存是加密的 格式 .rtf

End Sub

Private Sub color_Click()

'颜色设置

CM1.ShowColor

RT1.SelColor = CM1.Color

End Sub

Private Sub copy_Click()

'设置复制

Clipboard.SetText RT1.SelText

End Sub

Private Sub cut_Click()

'设置剪切

Clipboard.SetText RT1.SelText

RT1.SelText = ""

End Sub

Private Sub date_Click()

'设置日期

RT1.Text = RT1.Text &Now

End Sub

Private Sub delete_Click()

'设置删除

RT1.SelText = ""

End Sub

Private Sub fontname_Click()

CM1.ShowFont

With RT1

.SelBold = CM1.FontBold

.SelFontName = CM1.FileName

.SelFontSize = CM1.FontSize

.SelItalic = CM1.FontItalic

.SelUnderline = CM1.FontUnderline

.SelStrikeThru = CM1.FontStrikethru

End With

End Sub

Private Sub Form_Load()

'设置窗体和控件的宽高关系

x = Form1.Width - RT1.Width

y = Form1.Height - RT1.Height

'设置窗体载入时初始属性

RT1.Font.Name = "楷体"

RT1.Font.Size = "20"

End Sub

Private Sub Form_Resize()

'设置窗体和控件的宽高关系

RT1.Width = Me.Width - x

RT1.Height = Me.Height - y

End Sub

Private Sub Form_Unload(Cancel As Integer) '设置窗体卸载的提示框

If MsgBox("是否保存修改？", vbOKCancel, "记事本提示") = vbOK Then

Cancel = False

End

Else

Cancel = True

Exit Sub

End If

End Sub

Private Sub help_Click()

'帮助设置

CM1.ShowHelp

End Sub

Private Sub new_Click()

'设置新建

Dim frm As Form

Set frm = New Form1

frm.Show

counter = counter + 1

frm.Caption = frm.Caption &counter

End Sub

Private Sub Open_Click()

'设置打开

CM1.ShowOpen

RT1.FileName = CM1.FileName

End Sub

Private Sub plaster_Click()

'设置粘贴

RT1.SelText = Clipboard.GetText

End Sub

Private Sub print_Click()

'设置打印

CM1.ShowPrinter

End Sub

Private Sub quit_Click()

If MsgBox("是否保存修改？", vbOKCancel, "记事本提示") = vbOK Then

End

Else

Exit Sub

End If

End Sub

Private Sub RT1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

'设置右键快捷菜单

If Button = vbRightButton Then

Form1.PopupMenu edit

End If

End Sub

Private Sub save_Click()

'设置保存

RT1.Text = RT1.Text &RT1.FileName

RT1.SelStart = Len(RT1.Text) '将光标移动到最后

End Sub

RT1===》richtextbox 控件

需要的话给我留言，我把源代码发给你。

---