选择题答题卡图像自动剪切，识别能否实现？

592rmb

关键是用红色(醒目)把错题标出来！

592rmb

zopey 发表于 2018-8-20 17:51
这个功能 有啥用处，人工复核 ？其实就是 根据文件名插入图片，论坛很多例子可以参考。
你应该 把关注点 ...

老师请继续关注帮忙完善，谢谢！

592rmb

顶一下，别沉了，今晚又要考试

zopey

592rmb 发表于 2018-8-21 10:23
老师请继续关注帮忙完善，谢谢！

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim f As String
If Target.Column > 1 Then Exit Sub
If Target.Row < 4 Then Exit Sub
If Target.Value = "" Then Exit Sub
f = ThisWorkbook.Path & "\pic\" & Target.Value & ".bmp"
If Dir(f) = "" Then Exit Sub
MsgBox "答题卡： " & Target.Value

Dim Dm
Set Dm = CreateObject("dm.dmsoft")
hwnd = Dm.GetMousePointWindow()
dm_ret = Dm.GetClientRect(hwnd, x1, y1, x2, y2)

    Set Rng = Target.Offset(5, 1)
    ActiveSheet.Pictures.Insert(f).Select
    With Selection
        .Top = Rng.Top
        .Left = Rng.Left
    End With

Do
p1 = Dm.FindPic(0, 0, 1042, 900, ThisWorkbook.Path & "\021.bmp", "000000", 0.9, 0, tx0, ty0)
DoEvents
Loop Until p1 = 0
tx0 = tx0 + 24: ty0 = ty0 - 181

k0 = 0
Do While True
For i = 1 To 5
If Cells(Target.Row, k0 * 5 + i + 1) <> Cells(3, k0 * 5 + i + 1) Then
   J = AscW(Cells(Target.Row, k0 * 5 + i + 1)) - 64
   tx = tx0 + (J - 1) * 36
   ty = ty0 + (i - 1) * 32
    f2 = ThisWorkbook.Path & "\red.bmp"
    If Dir(f2) <> "" Then
    ActiveSheet.Pictures.Insert(f2).Select
    With Selection
        .Top = (ty - y1 - 18) * 100 / 133
        .Left = (tx - x1 - 34) * 100 / 133
    End With

    End If
End If
Next

k0 = k0 + 1: If k0 = 5 Then Exit Sub
If k0 < 4 Then
   tx0 = tx0 + 181
Else
   tx0 = tx0 - 181 * 3
   ty0 = ty0 + 181
End If

Loop

Set Dm = Nothing
End Sub


大漠识图3.zip (1.46 MB, 下载次数: 57)

2018-8-23 09:07 上传

点击文件名下载附件