vb代码编写（VB编写个代码）

：暂无数据 2026-04-08 14:40:02 ：0

我们注意到，那些在vb代码编写上表现突出的人，往往都对VB编写个代码有独到的见解。这并非巧合。

本文目录

VB编写个代码
怎样vb代码编写一个用星号组成的五角星
简单VB代码编写
用vb程序编写

VB编写个代码

通常情况下，我们使用Msgbox函数来写提示框信息。

根据你的描述，推想你大概需要下面这样的代码：

Private Sub Command1_Click()
    If MsgBox("是否使用？", vbOKCancel + vbExc****tion) = vbCancel Then
        ’vbokcancel 表示提示框上显示确认和取消两个按钮
        ’vbexc****tion  提示框上显示感叹号

        Text1.Text = ""    ’清空Text1
    Else
        Exit Sub
    End If
End Sub
Private Sub Command2_Click()
    If MsgBox("Text2文本框显示的内容是：" & Text2.Text & "，清除Text2里面的内容？", vbYesNo + vbInformation) = vbYes Then
        ’vbyesno  表示提示框上显示是和否两个按钮
        ’vbinformation  表示提示框想显示一个信息提示i符号
        Text2.Text = ""
    End If
End Sub

你可以在窗体上加入command1,command2,text1,text2四个控件进行测试！

怎样vb代码编写一个用星号组成的五角星

Sub ss()
    x1 = 20: y1 = 0
    x2 = 1: y2 = 7
    x3 = 39: y3 = 7
    x4 = 8: y4 = 18
    x5 = 32: y5 = 18
    For i = 0 To 6
        For j = 0 To 40
            If j - x4 》= (x1 - x4) * (i - y4) / (y1 - y4) And j - x5 《= (x1 - x5) * (i - y5) / (y1 - y5) Then
                Debug.Print "*";
            Else
                Debug.Print " ";
            End If
        Next
        Debug.Print
    Next
    For i = 7 To 18
        For j = 0 To 40
            If (j - x5 》= (x2 - x5) * (i - y5) / (y2 - y5) And j - x5 《= (x1 - x5) * (i - y5) / (y1 - y5)) Or (j - x4 》= (x1 - x4) * (i - y4) / (y1 - y4) And j - x4 《= (x3 - x4) * (i - y4) / (y3 - y4)) Then
                Debug.Print "*";
            Else
                Debug.Print " ";
            End If
        Next
        Debug.Print
    Next
End Sub

简单VB代码编写

首先先设计完界面（省略），然后编写一个通用的颜色函数：
sub
colorchange(r
as
integer,g
as
integer,b
as
integer)
label1.backcolor=rgb(r,g,b)
end
sub
然后双击每个水平滚动条，在里边都写这样的代码：
colorchange(cint(hs1.value),cint(hs2.value),cint(hs3.value))
大致给你一个思路，看看如何？相信自己思考会写出。

用vb程序编写

告诉你个诀窍，新建一个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
    C***t 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 mnuWindowArrangeIc***_Click()
    Me.Arrange vbArrangeIc***
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 mnuViewOpti***_Click()
    ’应做:添加 ’mnuViewOpti***_Click’ 代码。
    MsgBox "添加 ’mnuViewOpti***_Click’ 代码。"
End Sub
Private Sub mnuViewRefresh_Click()
    ’应做:添加 ’mnuViewRefresh_Click’ 代码。
    MsgBox "添加 ’mnuViewRefresh_Click’ 代码。"
End Sub
Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    **StatusBar.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