申请表单填写_VBA

用户窗体设计如下：

代码如下：

Dim FilePath As String

Private Sub GetButton_Click() '通过加载外部html文件来填写文本框
    '打开文件对话框，选择html文件
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    fd.AllowMultiSelect = False
    fd.Title = "请选择html文件"
    fd.Filters.Clear
    fd.Filters.Add "HTML文件", "*.html"
    
    If fd.Show = -1 Then
        '获取选择的文件路径
        
        FilePath = fd.SelectedItems(1)
        
        '读取html文件内容
        Dim fso As Object
        Set fso = CreateObject("scripting.filesystemobject")
        Dim filecontent As String
        filecontent = fso.opentextfile(FilePath, 1).readall
        
        '提取信息：姓名、性别、年龄、床号、住院号及诊断，这个需要根据外部文件的格式来“个性化制作”
        Start = InStr(filecontent, "patient.name") + 14
        last = InStr(Start, filecontent, "</TD>")
        Me.NameBox.Value = Mid(filecontent, Start, last - Start)

        '上面这段代码中的14，是从patient.name中的p到>的字符数，因为代码不一样，所以会面临这个数字需要手动计算的缺点；
        '通过InStr()函数的功能，可以克服这个缺点，对上述代码进行更新：
        'Start1 = InStr(filecontent, "patient.name")
        'last = InStr(Start1, filecontent, "</TD>")
        'str1 = Mid(filecontent, Start1, last - Start1) '得到从P之后到</TD>之前这一段字段
        'Start = Start1 + InStr(str1, ">") '在str1中查找>首次出现的位置，在P的位置的基础上获取新的"Start"
        'Me.NameBox.Value = Mid(filecontent, Start, last - Start) '获取>之后和</TD>之间的所有字段。
        '以上：2023-4-9
        
        Start = InStr(filecontent, "patient.sex") + 13
        last = InStr(Start, filecontent, "</TD>")
        Me.GenderComboBox.Value = Mid(filecontent, Start, last - Start)
        
        Start = InStr(filecontent, "patient.age") + 13
        last = InStr(Start, filecontent, "</TD>")
        Me.AgeBox.Value = Mid(filecontent, Start, last - Start)
        
        Start = InStr(filecontent, "residence.now.bed") + 19
        last = InStr(Start, filecontent, "</TD>")
        Me.Bedbox.Value = Mid(filecontent, Start, last - Start)
        
        Start = InStr(filecontent, "residence.event") + 17
        last = InStr(Start, filecontent, "</TD>")
        Me.IDBox.Value = Mid(filecontent, Start, last - Start)
        
        Start = InStr(filecontent, "诊断/入院初步诊断") + 46
        last = InStr(Start, filecontent, "</TD>")
        
        '提取的诊断中有空格符——"&nbsp"——，通过`Do While... Loop`循环删除
        Dim a, b As String
        a = Mid(filecontent, Start, last - Start)
        b = "&nbsp"
        Do While InStr(b, "&nbsp") <> 0 'instr中若不包含某字符，则取0，0以后的数字表示仍包含所查找的字符
        
            b = Replace(a, "&nbsp", "") '通过replace函数来删除特定字符
        Loop
        
        Me.DiaTextBox.Value = b
        
    End If
    Kill FilePath '内容加载完毕后删除文件
End Sub

'给下拉列表框添加选项
Private Sub ItemComboBox_Enter()
    ItemComboBox.List = Array("细菌培养", "细菌培养+药敏") 
End Sub

Private Sub DocComboBox_Enter()
    DocComboBox.List = Array("医生1", "医生2", "医生3", "医生4")
End Sub

Private Sub GenderComboBox_Enter()
    GenderComboBox.List = Array("男", "女")
End Sub

'将用户窗体中填写的内容写入单元格
Private Sub PrintButton_Click()
    With Sheet1
        .Cells(3, 2).Value = Me.NameBox.Value
        .Cells(3, 4).Value = Me.GenderComboBox.Value
        .Cells(3, 6).Value = Me.AgeBox.Value
        .Cells(4, 2).Value = Me.ItemComboBox.Value
        .Cells(4, 4).Value = Me.Bedbox.Value
        .Cells(4, 6).Value = Me.IDBox.Value
        .Cells(5, 2).Value = Me.DiaTextBox.Value
        .Cells(6, 2).Value = Me.LocBox.Value
        .Cells(7, 2).Value = Me.TypeBox.Value
        .Cells(9, 2).Value = Me.DocComboBox.Value
        .Cells(9, 6).Value = Now()
    End With
    
    '打印表单
    ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
        
End Sub

'清空窗体中用户填写的内容
Private Sub ClearButton_Click()
    NameBox.Value = ""
    GenderComboBox.Value = ""
    AgeBox.Value = ""
    ItemComboBox.Value = ""
    Bedbox.Value = ""
    IDBox.Value = ""
    DiaTextBox.Value = ""
    LocBox.Value = ""
    TypeBox.Value = ""
    DocComboBox.Value = ""
End Sub

Private Sub QuitButton_Click()
    ActiveWorkbook.Save
    Application.Quit
End Sub

在ThisWorkbook中使用如下代码，使打开此文件的时候自动打开应用户窗体：

Private Sub Workbook_Open()
    细菌培养申请单.Show '“细菌培养申请单”是用户窗体的名称
End Sub