ADODB나 OLEDB로 ACCESS DB(mdb, accdb)를 사용할 때.

 

일련번호 형식의 SEQ라던지 Identity 필드값을 초기화 하는 방법.

 

참고로 MS-SQL 에서는 이렇게 처리한다.

 

DBCC CHECKIDENT('테이블명',RESEED,0)

이렇게 하면 다음번 insert시에  시드가 1부터 시작하게 되고..

 

DBCC CHECKIDENT('테이블명',RESEED,9999)

이렇게 하면 10000부터 시작된다.

 

 

 

이걸 엑세스(access 2007 에서만 해봤음)  에서 구현하려면~

 

ALTER TABLE [테이블명] ALTER COLUMN [컬럼명] COUNTER(1,1)

 

무슨.... 엑세스에 가서 데이터베이스 압축/복구를 하라느니 복잡하고 귀찮은 설명이 있는데

 

외부프로그램에서나 엑세스 내부에서나  위 쿼리를 한번 돌려주면 끝남. 단, 그전에 테이블의 모든 데이터를 삭제하고 해야함.

 

또한 PK,FK 등  관계가 걸려있는 경우에는 안 될수도 있음..

 

 

화면에 메시지를 표시하려면 MsgBox 함수를 사용합니다.

 

예를 들어 다음 코드는 화면에 "LOTIONY" 라는 문자열을 표시합니다.

Sub Sample ()
    MsgBox "LOTIONY"
End Sub

 

화면에는 [OK] 버튼이 있는 메시지 상자가 표시됩니다.

이 메시지 상자는 사용자가 OK 버튼을 누를 때 까지 계속해서 모달창으로 표시가 되지요.

 

지정된 시간이 지나면 자동으로 닫히는 메시지 상자를 만들수는 없을까 해서 찾아보았습니다.

 

우선 MsgBox가 가지고 있는 기본 인자값들만으로는 구현이 불가능했습니다.

그리고 그것을 대체할만한 함수나 기능이 VB/VBA 에는 별도로 마련되어 있지 않습니다.

이 기능을 구현하려면 Windows Scripting Host (WSH) 를 사용합니다.

 

 

 

지정된 시간이 지나면 자동으로 닫히는 메시지박스(MsgBox) 만들기

 

Sub test()
    Dim WSH As Object
    Set WSH = CreateObject("WScript.Shell")
    WSH.Popup "5 초 후 자동으로 닫습니다", 5, "Title", vbInformation
    Set WSH = Nothing
End Sub

 

 

 

WSH.Popup (strText, [nSecondsToWait], [strTitle], [nType])

 

 매개변수

 의미

 strText

 메시지 상자에 표시 할 문자열. 필수 요소

 nSecondsToWait

 메시지 상자를 닫을 때까지의 시간. 선택적

 strTitle

 메시지 상자의 제목. 선택적

 nType

 아이콘이나 버튼의 종류. 선택적

 

 

 

매개변수 nSecondsToWait에서 지정한 시간이 되기 전에 사용자가 버튼을 조작하면 언제든지 메시지박스를 닫을 수 있습니다.

매개변수 nType은 다음 값을 지정할 수 있고 MsgBox 에서 사용되는 상수와 다르지 않습니다.

 

 값

VBA 상수 

의미 

 0

 vbOKOnly  [OK] 버튼을 표시합니다

 1

 vbOKCancel  [OK] 버튼과 취소 버튼을 표시합니다

 2

 vbAbortRetryIgnore  중지 버튼, 다시 시도 버튼 및 무시 단추를 표시합니다

 3

 vbYesNoCancel  [예] 버튼 아니요 단추 및 취소 단추를 표시합니다

 4

 vbYesNo  [예] 버튼과 [아니오] 버튼을 표시합니다

 5

 vbRetryCancel  다시 시도 버튼과 취소 버튼을 표시합니다

 16

 vbCritical   아이콘을 표시합니다

 32

 vbQuestion    아이콘을 표시합니다

 48

 vbExclamation   아이콘을 표시합니다

 64

 vbInformation   아이콘을 표시합니다

 

 

 

Popup메서드로 띄운 메시지 상자에서 버튼을 클릭했을 때 반횐되는 값도 MsgBox와 동일합니다.

 

 값

VBA 상수

클릭된 버튼 

 1

 vbOK  [OK] 버튼

 2

 vbCancel  취소 버튼

 3

 vbAbort  중지 버튼

 4

 vbRetry  다시 시도 버튼

 5

 vbIgnore  무시 버튼

 6

 vbYes  [예] 버튼

 7

 vbNo  아니오 버튼

 

시간이 경과해서 자동으로 메시지상자가 닫힌 경우에는 -1 이 리턴됩니다.
 


유저폼(Userform)은 엑셀 솔루션을 만들 때 많이 사용되는 요소입니다.


대부분의 경우, 평범하게 컨트롤들 올려서 사용하겠지요. 유저폼의 용도가 원래 그런것이니까 ^^;

하지만 모달리스(Modaless) 유저폼에 윈도우 API를 사용하면 단순한 유저폼이 아니게 변신시킬 수도 있습니다.

참고1
모달리스 유저폼을 만들면 유저폼이 떠 있는 상태에서도 그 밑에 있는 엑셀 시트를 제어하고, 여러 개의 유저폼을 동시에 띄워두고도 각각 별개로 컨트롤이 가능하게 됩니다.
프로그램의 순서나 흐름 제어를 지킬 수 없기 때문에 (사용자가 어떤 창에서 어떤 액션을 할지 예측할 수도 없고 통제할 수도 없으므로)  개발자가 의도하는 순서대로 진행되어야 할 경우엔 모달리스를 사용하면 안 됩니다.

모달리스(Modaless) 설정을 변경하는 방법은 두 가지가 있습니다.
  1. Userform 속성에서  [ShowModal] 프로퍼티를 False로 변경.
  2. 유저폼을 띄울 때  옵션값을 0으로 지정.  Userform1.Show 0 


API로 할 수 있는 건 여러가지가 있지만, 실제로 써먹을 수 있을만한 3가지만 소개하겠습니다.


타이틀바(캡션바) 없는 유저폼 만들기(Caption hidden Userform)


 모양

API 적용


    Dim hwnd As Long
    hwnd = FindWindow(IIf(Application.Version >= 11, "ThunderDFrame", "ThunderXFrame"), Caption)

    '***** 캡션창을 없앤다.
    SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) And Not WS_CAPTION





모서리가 둥근 유저폼 만들기(Round Rect Userform)


 모양

 

API 적용


    Dim hwnd As Long
    hwnd = FindWindow(IIf(Application.Version >= 11, "ThunderDFrame", "ThunderXFrame"), Caption)

    '***** 설정된 값으로 모서리가 둥근 유저폼 생성한다.
    SetWindowRgn hwnd, CreateRoundRectRgn(0, 0, Me.Width + 100, Me.Height, 20, 20), True




유저폼 반투명하게 만들기(Transparent Userform)


 모양

API 적용


    Dim hwnd As Long
    hwnd = FindWindow(IIf(Application.Version >= 11, "ThunderDFrame", "ThunderXFrame"), Caption)

    '***** 반투명 레이어로 만들기 위해 유저폼 셋팅
    SetWindowLong hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    
    '***** 반투명 폼으로 적용(0~255)
    SetLayeredWindowAttributes hwnd, 0, 195, LWA_ALPHA


위의 방법을 다 적용하면 다음과 같이 타이틀바 없고, 모서리가 둥글고, 반투명한  유저폼도 생성할 수 있습니다. ^^


<타이틀바 없고, 모서리가 둥글고, 반투명한 유저폼>


하지만 너무 과도하게 효과를 넣으면 오히려 보기 싫어질 수가 있겠죠?


위에 간단하게 API 코드를 적었습니다만, 당연히 그냥은 실행이 안됩니다.

API 함수를 선언해 줘야 하고, 사용된 상수값들도 셋팅해 줘야겠죠.


그런데 위와 같은 유저폼을 옮기고 싶으면 어떻게 할까요? 

MouseMove이벤트와 API를 이용해서 Userform 아무곳을 클릭하고 드래그 하면 이동되게 할 수 있습니다.


또, 예기치않게 사용자가 창을 닫아버리는 걸 방지하고 싶다면 어떻게 할까요?

캡션바가 없어졌으므로 우측상단의 X 버튼은 자연히 사용할 수 없게 되었습니다.

Alt+F4로 폼을 닫는 것도 막아버릴 수 있습니다. 

사용자는 오직 내가 만들어놓은 Close버튼을 눌러야만 창을 닫을 수 있습니다.

이렇게 사용자의 행동을 내가 원하는 대로 제한시킬 수 있습니다. 종종 생기죠, 이런 경우. ㅎㅎ



위의 모든 내용을 아우르는 코드입니다..


1. Userform을 하나 생성하고, 버튼을 하나 만듭니다.(CommandButton1)

2. 아래 코드를 붙여넣습니다.

'//********** API용 상수값 설정
Private Const WS_CAPTION = &HC00000

Private Const LWA_COLORKEY = &H1        '## 색상지정값 확정
Private Const LWA_ALPHA = &H2           '## 투명도 확정
Private Const GWL_STYLE = (-16)         '## 윈도우 스타일
Private Const GWL_EXSTYLE = (-20)       '## 확장형윈도우 스타일
Private Const WS_EX_LAYERED = &H80000   '## 계층형 윈도우 생성

Private Const WM_NCMOUSEMOVE = &HA0
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const WM_NCLBUTTONUP = &HA2
Private Const WM_NCLBUTTONDBLCLK = &HA3
Private Const WM_NCRBUTTONDOWN = &HA4
Private Const WM_NCRBUTTONUP = &HA5
Private Const WM_NCRBUTTONDBLCLK = &HA6
Private Const WM_NCMBUTTONDOWN = &HA7
Private Const WM_NCMBUTTONUP = &HA8
Private Const WM_NCMBUTTONDBLCLK = &HA9
Private Const HTCAPTION = 2


Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ReleaseCapture Lib "user32" ()

                                                       




Private Sub CommandButton1_Click()
    Unload Me
End Sub




Private Sub UserForm_Initialize()
    
    Dim hwnd As Long
    hwnd = FindWindow(IIf(Application.Version >= 11, "ThunderDFrame", "ThunderXFrame"), Me.Caption)
    
    '***** 캡션창을 없앤다.
    SetWindowLong hwnd, GWL_STYLE, GetWindowLong(hwnd, GWL_STYLE) And Not WS_CAPTION
    
    '***** 설정된 값으로 모서리가 둥근 유저폼 생성한다.
    SetWindowRgn hwnd, CreateRoundRectRgn(0, 0, Me.Width + 100, Me.Height, 20, 20), True
    
    '***** 반투명 레이어로 만들기 위해 유저폼 셋팅
    Call SetWindowLong(hwnd, GWL_EXSTYLE, GetWindowLong(hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    
    '***** 반투명 폼으로 적용(0~255)
    Call SetLayeredWindowAttributes(hwnd, 0, 195, LWA_ALPHA)
    
    Me.Height = Me.Height + 1
    
End Sub




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

    Dim hwnd As Long

    '***** 마우스 왼쪽 버튼을 누은 상태에서 Drag한다면
    If Button = 1 And Shift = 0 Then

        '***** 유저폼의 핸들을 취득한다.
        hwnd = FindWindow(IIf(Application.Version >= 11, "ThunderDFrame", "ThunderXFrame"), Me.Caption)

        '***** 마우스 이벤트이외의 이벤트 발생을 허용
        Call ReleaseCapture
        
        '***** 해당 지점을 Caption Bar로 인식시킨다.
        Call SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)

    End If
    
End Sub




Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    '***** Alt+F4로도 종료하지 못하도록 조치함
    Cancel = CloseMode = 0
End Sub




참고2

FindWindow 함수로는 현재 유저폼의 핸들을 취득합니다. 

엑셀 자체 프로그램의 핸들은 Application.hwnd 메서드로 바로 구할 수가 있지만, 유저폼에서는 지원되지 않습니다.

유저폼의 핸들은 FindWindow API함수를 이용해 찾을 수 있습니다.

hwnd = FindWindow(IIf(Application.Version >= 11, "ThunderDFrame", "ThunderXFrame"), Me.Caption)


이 포스팅에 소개한 예제 파일입니다.


이외에도 유저폼에 애니메이션 효과를 줄 수 있는 AnimateWindow 함수, 

포지션 및 크기를 Windows기준으로 설정할 수 있는 MoveWindow 함수, 

각 유저폼(또는 특정 핸들)을 다른 폼에 종속시킬 수 있는 SetParent 함수 등

필요에 따라 많은 API함수를 적용해 볼 수 있습니다.




VBA에서 사용되는 Userform은 기본적으로 사이즈조절(Resizable)이 되지 않습니다.

이 설정을 변경하는 옵션 또한 지원되지 않습니다.

하지만 기본적으로 Userform은 Windows Form 2.0 을 사용하는 일반 윈도우폼입니다.

 

그동안은 사용할 없었는데, 요번에 사용자에 의해서 크기가 조절되어야 하는 유저폼이 필요한 일이 생겨 찾게 되었습니다.

방법은 그다지 어렵지 않더군요..

  

1. 빈 유저폼을 만듭니다.

 

2. 프로젝트 탐색기에서 우클릭 한 후 [삽입] – [클래스 모듈] 을 선택해 클래스모듈을 하나 만들어 줍니다.


3. 속성에서 방금 생성된 클래스모듈의 이름을 CResizer 로 변경합니다.
    (속성창이 안 보이면 F4)


4. CResizer 클래스모듈에 아래의 코드를 복사해 붙여 넣습니다.

Option Explicit

Private Const MFrameResizer = "FrameResizeGrab"
Private Const MResizer = "ResizeGrab"
Private WithEvents m_objResizer As MSForms.Frame
Private m_sngLeftResizePos As Single
Private m_sngTopResizePos As Single
Private m_blnResizing As Single
Private WithEvents m_frmParent As MSForms.UserForm
Private m_objParent As Object

Private Sub Class_Terminate()

    m_objParent.Controls.Remove MResizer
    
End Sub


Private Sub m_frmParent_Layout()
    
    If Not m_blnResizing Then
        With m_objResizer
            .Top = m_objParent.InsideHeight - .Height
            .Left = m_objParent.InsideWidth - .Width
        End With
    End If

End Sub


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

    If Button = 1 Then
        m_sngLeftResizePos = x
        m_sngTopResizePos = y
        m_blnResizing = True
    End If
    
End Sub
Private Sub m_objResizer_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)

    If Button = 1 Then
        With m_objResizer
            .Move .Left + x - m_sngLeftResizePos, .Top + y - m_sngTopResizePos
            m_objParent.Width = m_objParent.Width + x - m_sngLeftResizePos
            m_objParent.Height = m_objParent.Height + y - m_sngTopResizePos
            .Left = m_objParent.InsideWidth - .Width
            .Top = m_objParent.InsideHeight - .Height
        End With
    End If
    
End Sub
Private Sub m_objResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    If Button = 1 Then
        m_blnResizing = False
    End If

End Sub


Public Function Add(Parent As Object) As MSForms.Frame
'
' add resizing control to bottom righthand corner of userform
'
    Dim labTemp As MSForms.Label
    
    Set m_frmParent = Parent
    Set m_objParent = Parent
    
    Set m_objResizer = m_objParent.Controls.Add("Forms.Frame.1", MFrameResizer, True)
    Set labTemp = m_objResizer.Add("Forms.label.1", MResizer, True)
    With labTemp
        With .Font
            .Name = "Marlett"
            .Charset = 2
            .Size = 14
            .Bold = True
        End With
        .BackStyle = fmBackStyleTransparent
        .AutoSize = True
        .BorderStyle = fmBorderStyleNone
        .Caption = "o"
        .MousePointer = fmMousePointerSizeNWSE
        .ForeColor = RGB(100, 100, 100)
        .ZOrder
        .Top = 1
        .Left = 1
        .Enabled = False
    End With
    
    With m_objResizer
        .MousePointer = fmMousePointerSizeNWSE
        .BorderStyle = fmBorderStyleNone
        .SpecialEffect = fmSpecialEffectFlat
        .ZOrder
        .Caption = ""
        .Width = labTemp.Width + 1
        .Height = labTemp.Height + 1
        .Top = m_objParent.InsideHeight - .Height
        .Left = m_objParent.InsideWidth - .Width
    End With
End Function


5. 만들어 두었던 유저폼(Userform1) 에 아래의 코드를 붙여 넣습니다.

Private m_clsResizer As CResizer


Private Sub UserForm_Initialize()
    
    Set m_clsResizer = New CResizer
    m_clsResizer.Add Me

End Sub


Private Sub UserForm_Terminate()
    Set m_clsResizer = Nothing
End Sub


6. Userform1.show 로 유저폼을 띄워보면 우측하단에 Resize 조절이 가능한 표시가 보이게 됩니다.

   

 

이렇게 크기 조절이 가능한 유저폼(Resizable Userform)을 만들었습니다.

물론 이렇게까지만 해놓고 쓸일은 없겠죠. 크기조절을 시킬 때 무언가를 해 주어야 합니다.

그냥 크기만 늘었다 줄었다 하면 아무 소용이 없죠…

폼 안에 있는 컨트롤을 동적으로 움직여줘야 할 수도 있고, 여튼 폼 크기 조절을 사용자에게 시키려던 목적이 있을겁니다.

그리고 그 액션에 대응하는 코드도 작성을 해 주어야 합니다.

이 코드는 Userform1_Resize() 이벤트 프로시저 안에 작성해 주면 됩니다.

 

1. Userform1에 빈 레이블(Label)을 아무곳에나 하나 추가합니다. 
   그리고 유저폼 초기화 프로시저를 아래처럼 수정합니다.

Private Sub UserForm_Initialize()
    
    Set m_clsResizer = New CResizer
    m_clsResizer.Add Me
    
    With Label1
        .Visible = False
        .Top = Me.Height - .Height - 30
        .Left = Me.Width - .Width - 20
    End With
End Sub


2. Userform 코드에 아래와 같이 Resize 이벤트 프로시저를 추가해 줍니다.

Private Sub UserForm_Resize()
    With Label1
        .Caption = "W : " & Me.Width & "  H : " & Me.Height
        .Top = Me.Height - .Height - 30
        .Left = Me.Width - .Width - 20
    End With
End Sub


3. CResizer 클래스 모듈에서 MouseDown과 MouseUp 프로시저를 찾아 아래처럼 수정해 줍니다. 이건 기능보다는 약간의 재미를 위해서입니다.

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

    If Button = 1 Then
        m_sngLeftResizePos = x
        m_sngTopResizePos = y
        m_blnResizing = True

        '***** Label Visible
        m_objParent.Label1.Visible = True
    End If
    
End Sub


Private Sub m_objResizer_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    If Button = 1 Then
        m_blnResizing = False
        
        '***** Label Invisible
        m_objParent.Label1.Visible = False
    End If

End Sub


4. 유저폼을 실행한 후 크기조절을 해 보면 아래처럼 현재 창의 크기가 레이블에 표시되고, 창의 크기와 관계없이 우측 하단 고정된 위치에 따라붙게 됩니다.

 

그다지 많이 쓰일일은 없지만, 활용 여하에 따라 보다 나은 Activity한 UX를 설계할 수 있지 않을까 생각됩니다.



 

VBA에서 스캐너 Twain 드라이버와 이미지프로세싱툴인 LEAD Tools를 이용해 스캐너를 제어하고 이미지를 만들어 저장한다.



* ltocx13n.ocx 파일을 System32 디렉토리에 카피.
* [도구] -> [참조] 에서 LEAT Main Control 등록.


Sett 이름의 시트의 A와 B열에 이런모양으로다가 환경설정값을 저장해놓고 불러다 쓰도록 한다. 환경설정폼은 알아서..

DeviceName KODAK Scanner: i1120
Resolution 200 Dpi
Color 흑백
Page 단면
Paper A4 크기


VBE에서 간단하게 유저폼 생성해서 버튼2개와 LEAD Main Control 추가.
[도구] -> [추가 컨트롤] 에서 LEAD Main Control (13.0) 체크한다음 폼에다 올려준다.



Dim TwainF_W, TwainF_H
Dim TwainPixT, TwainBit

'******************************************************************************
' Direct Scan Button Click
'******************************************************************************
Sub cmdScanST_Click()


Hwnd = FindWindow(vbNullString, Me.Caption)
LEAD1.AutoSetRects = True
LEAD1.AutoRepaint = False

LEAD1.EnableTwainEvent = True

'//////// 설정 저장값에 따라 상수값 변환
Select Case Replace(Sett.Range("B5"), " 크기", "")
    Case "기본값": TwainF_W = 11952: TwainF_H = 16848
    Case "A3": TwainF_W = 16838: TwainF_H = 23811   '11.7 x 16.5 inches
    Case "A4": TwainF_W = 11952: TwainF_H = 16848   '8.3 x 11.7 inches
    Case "A5": TwainF_W = 8352: TwainF_H = 11952    '5.83 x 8.3 inches
    Case "B4": TwainF_W = 14570: TwainF_H = 20636   '10.1 x 14.3 inches
    Case "B5": TwainF_W = 10368: TwainF_H = 14544   '7.2 x 10.1 inches
End Select

Select Case Sett.Range("B3")
    Case "흑백": TwainPixT = TWAIN_PIX_HALF: TwainBit = 1
    Case "8 bit 회색조": TwainPixT = TWAIN_PIX_GRAY: TwainBit = 8
    Case "24 bit 컬러": TwainPixT = TWAIN_PIX_RGB: TwainBit = 24
End Select

With LEAD1
    .TwainSourceName = Sett.Range("B1").Value
    .TwainMaxPages = -1               'Default
    .TwainAppAuthor = ""              'Default
    .TwainAppFamily = ""              'Default
    .TwainFrameLeft = -1              'Default
    .TwainFrameTop = -1               'Default
    .TwainFrameWidth = TwainF_W
    .TwainFrameHeight = TwainF_H
    .TwainBits = TwainBit
    .TwainPixelType = TwainPixT
    .TwainRes = Val(Sett.Range("B2").Value)
    .TwainContrast = TWAIN_DEFAULT_CONTRAST          'Default contrast
    .TwainIntensity = TWAIN_DEFAULT_INTENSITY        'Default intensity
    .EnableTwainFeeder = True
    .EnableTwainAutoFeed = True
    .EnableTwainDuplex = 0
End With

    SavedSetting = LEAD1.EnableMethodErrors
   
    Me.MousePointer = 11 'Set the pointer to an hourglass
    LEAD1.TwainRealize (Hwnd)
    Me.MousePointer = 0 'Set the mouse pointer back to the default
       
   
    LEAD1.TwainFlags = 0
    LEAD1.EnableMethodErrors = False
    nRet = LEAD1.TwainAcquire(Hwnd)
    If nRet <> SUCCESS Then
        MsgBox "TWAIN 장치가 준비되지 않았습니다."
        LEAD1.EnableMethodErrors = SavedSetting
        GoTo FINISHED
    End If
FINISHED:
    LEAD1.EnableMethodErrors = SavedSetting
    LEAD1.EnableTwainEvent = False
   
    'LEAD1.BitonalScaling = BITONALSCALING_SCALETOGRAY
    'LEAD1.AutoScroll = True
    'LEAD1.DstWidth = LEAD1.ScaleWidth 'Use the full control width.
    'LEAD1.DstClipWidth = LEAD1.ScaleWidth
    'CalcHeight = (LEAD1.BitmapHeight * LEAD1.ScaleWidth) / LEAD1.BitmapWidth
    'LEAD1.DstHeight = CalcHeight 'Use the proportional height.
    'LEAD1.DstClipHeight = CalcHeight
    'LEAD1.ForceRepaint

End Sub




'******************************************************************************
' Device Select Button Click
'******************************************************************************
Sub cmdSet_Click()
   
    On Error GoTo SELECT_CANCEL
   
    Hwnd = FindWindow(vbNullString, Me.Caption)
    LEAD1.TwainSelect Hwnd
   
    Sett.Range("B1") = LEAD1.TwainSourceName

    Exit Sub
   
SELECT_CANCEL:

End Sub







Private Sub LEAD1_TwainPage()

Dim PutRng As Range
Dim myfile As String

DoEvents

    '///// 오늘날짜 폴더 생성.
    Dim Path_add As String
    Dim file_name As String
        Path_add = ThisWorkbook.Path & "\ScanImages"
        file_name = ""
   
    If Dir(ThisWorkbook.Path & "\ScanImages", vbDirectory) = "" Then
        MkDir Path_add
    End If
   
    If Dir(ThisWorkbook.Path & "\ScanImages\" & Left(Now(), 10), vbDirectory) = "" Then
        MkDir Path_add & "\" & Left(Now(), 10)
    End If
   
    Path_add = Path_add & "\" & Left(Now(), 10)
   
   
    '///// 스캔 이미지 저장.
    Static PageCount As Integer
    PageCount = PageCount + 1
    myfile = Path_add & "\" & Left(Now(), 10) & "_" & Right("000" & PageCount, 4) & ".TIF"
    LEAD1.Save myfile, FILE_CCITT_GROUP4, TwainBit, 0, SAVE_OVERWRITE
    'LEAD1.Save myfile, FILE_TIF, TwainBit, 0, SAVE_OVERWRITE
   

    'Call OCRReader(myfile)
 
End Sub



당연히 이것만 가지고는 실행이 안된다.
리드툴은 창의 핸들을 필요로 한다 그렇기때문에 VBA의 Userform에 윈도우핸들값을 찾아다줘야 한다. (Hwnd) 

유저폼 코드에는 api를 public수준으로 갖다넣을수 없으므로 빈모듈을 하나 추가한다음

Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Public Declare Function EnumChildWindows Lib "user32" _
(ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByRef lparam As Long) As Long

Public Hwnd As Long
Public lparam As Long


이렇게 넣어준다.
창핸들을 잡는건 cmdScanST_Click() 프로시저에
Hwnd = FindWindow(vbNullString, Me.Caption)
이걸로 잡아주면된다.

LEAD1.EnableTwainEvent = True  해주면  스캔작업이 일어난 후에 자동으로 LEAD1_TwainPage()를 호출한다.

.EnableTwainFeeder = True
.EnableTwainAutoFeed = True
이 두개 프로퍼티를 True로 해주면 여러장 연속급지 처리가 된다.

.EnableTwainDuplex = 0
이 프로퍼티는 0일때 단면스캔, 1이면 양면스캔이다.
정확히는
Value                                    Meaning
TWAIN_DUPLEX_NONE        [0] No duplex scanning
TWAIN_DUPLEX_1PASS       [1] 1-Pass duplex scanning
TWAIN_DUPLEX_2PASS       [2] 2-Pass duplex scanning
TWAIN_UNSUPPORTED       [2001] The current Twain device does not support duplex scanning.


nRet = LEAD1.TwainAcquire(Hwnd)
twainActuire가 실제 스캔명령을 내리는 메서드이며 결과값을 nRet로 리턴한다. 성공하면 SUCCESS가 뜨고 LEAD1_TwainPage()로 넘어가서  지정된 동작을 수행하게 된다.

LEAD1.Save 가 파일저장 시키는 명령.



리드툴의 도움말 파일.

윈7에서 구 hlp파일을 열기 위해 필요한 업데이트 링크.
http://www.askvg.com/how-to-open-help-files-hlp-in-windows-7-that-require-windows-help-program-winhlp32-exe/

+ Recent posts