컴퓨토피아

VB, VBA, Win32, ExcelReport 전문 개발카페입니다. 많은 관심 부탁드리여~~^^

http://cafe.naver.com/xlsvba

걍 혹시 VB루 엑셀 리포트 하실일 생기시믄 사용하시믄 어떨가하고 올립니다..
쓰레기 자료일거 같아 좀 머뭇거리다가 올려봅니다...
제 레베루 잘 아시겠지만 신임도 50%두 안되는 소스이니 잘 수정하셔서 올려주시믄 잘 배껴쓰겟습니다....
일부 문제점이 잇을수 있을거 같기두 하궁...
최소 5개 이상의 Child폼에서 사용한다는 가정하에 Public으루 맨들었으니..
두서너군데에서  사용된다면 Class Module에 놓구 사용하심이 조을듯 싶습니다...

Option Explicit

Private Const PROCESS_TERMINATE = &H1&
Private Const SYNCHRONIZE = &H100000
Private Const SW_HIDE = 0
Private Const SW_SHOWNORMAL = 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const Flags = SWP_NOMOVE Or SWP_NOSIZE
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5

Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal HProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow 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 SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function SearchTreeForFile Lib "imagehlp" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long
Private Declare Function GetFullPathName Lib "kernel32" Alias "GetFullPathNameA" (ByVal lpFileName As String, ByVal nBufferLength As Long, ByVal lpBuffer As String, ByVal lpFilePart As String) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public XlApp As Object
Public XlWb As Object
Public Const XL_NOTRUNNING As Long = 429
Public Const XPath As String = "RPT시험위원문서양식"



'======================================================================================
' Function Name : GetXhwnd
' DateTime      : 2007-03-13 17:34
' Author        : 서은아빠 (foxmotor@nate.com)
' Purpose       : 해당 Excel파일의 핸들값을 구한다.
' Param         : strFN - 해당파일의 확장자와 Path를 제외한 이름
' Return        : GetXhwnd - 해당 Excel파일의 핸들값
'======================================================================================
Public Function GetXhwnd(ByVal strFN As String) As Long
   
   On Error GoTo GetXhwnd_Error

       GetXhwnd = FindWindow("XLMAIN", "Microsoft Excel - " & strFN & ".xls")

   On Error GoTo 0
   
   Exit Function

GetXhwnd_Error:

   On Error GoTo 0
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure GetXhwnd of Module modExcel", , vbCritical
End Function


'============================================================================================
' Procedure     : Process_Kill
' Description   : API로 해당 엑셀프로세스 주겨버리기
' Author        : 서은아빠 (foxmotor@nate.com)
' Return        :
' Parameter     :strFN   : 저정한 엑셀윈도우의 캡션명(확장자를 제외한 파일명)
'============================================================================================
Public Sub Process_Kill(ByVal strFN As String)
Dim Chwnd      As Long
Dim HProcess  As Long
Dim PID           As Long
Dim TID           As Long

   On Error GoTo Process_Kill_Error

      Chwnd = GetXhwnd(strFN)
   
      TID = GetWindowThreadProcessId(Chwnd, PID)
   
      HProcess = OpenProcess(SYNCHRONIZE Or PROCESS_TERMINATE, 0&, PID)
   
      Call TerminateProcess(HProcess, 0&)
   
      Call CloseHandle(HProcess)

      On Error GoTo 0
       
      Exit Sub

Process_Kill_Error:

   On Error GoTo 0
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Process_Kill of Module modExcel", , vbCritical

End Sub



'======================================================================================
' Procedure : XReOpen
' DateTime  : 2007-03-13 17:46
' Author    : 서은아빠 (foxmotor@nate.com)
' Purpose   : 오픈된 엑셀을 재 오픈할시에 발생하는 오류를 사전에 차단
' Param     : strDpath - 해당파일의 FullName
'======================================================================================
Public Sub XReOpen(ByVal strDpath As String)
 Dim strFN As String
   On Error GoTo XReOpen_Error
       
       strFN = Mid(strDpath, InStrRev(strDpath, "", , vbTextCompare) + 1, _
       Len(strDpath) - InStrRev(strDpath, "", , vbTextCompare) - 4)

       If GetXhwnd(strFN) Then Call Process_Kill(strFN)
       
       Set XlApp = CreateObject("Excel.Application")
       
       With XlApp
           .WindowState = -4140        '## xlMinimized
           .Visible = True
           .EnableAnimations = False
           .workbooks.Open strDpath
       End With

   On Error GoTo 0
   
   Exit Sub

XReOpen_Error:

   On Error GoTo 0
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure XReOpen of Module modExcel", , vbCritical
End Sub




'======================================================================================
' Procedure : XlSetCreate
' DateTime  : 2007-03-13 17:46
' Author    : 서은아빠 (foxmotor@nate.com)
' Purpose   : 엑셀 개체를 생성하고 새로운 워크북을 만들고 시트의 개수를 생성한다.
' Param     : intSht - 생성 시트개수
'             bState - 윈도우 상태설정 True - xlMaximized, False - xlMinimized
'======================================================================================
Public Sub XlSetCreate(ByVal intSht As Integer, Optional bState As Boolean = False)
 Dim lngState As Long
 
   On Error GoTo XlSetCreate_Error

       Set XlApp = CreateObject("Excel.Application")
       
       lngState = IIf(bState = True, -4137, -4140)
       With XlApp
           .WindowState = lngState
           .Visible = True
           .EnableAnimations = False
           .SheetsInNewWorkbook = IIf(intSht > 0, intSht, 1)
           Set XlWb = .workbooks.Add

       End With
       
   On Error GoTo 0
   
   Exit Sub

XlSetCreate_Error:

   On Error GoTo 0
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure XlSetCreate of Module modExcel", , vbCritical
End Sub


'======================================================================================
' Procedure : XPreview
' DateTime  : 2007-03-13 17:58
' Author    : 서은아빠 (foxmotor@nate.com)
' Purpose   : Excel의 미리보기 창을 최상위 윈도우루 설정 - MDI폼을 BackGround루~~
' Param     : strFN - 해당파일의 확장자와 Path를 제외한 이름
'======================================================================================
Public Sub XPreview(ByVal strFN As String)
   
   On Error GoTo XPreview_Error

       SetWindowPos MDI폼.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, Flags
       
       SetWindowPos GetXhwnd(strFN), HWND_TOPMOST, 0, 0, 0, 0, Flags
       
       XlApp.WindowState = -4137
       
       XlApp.workbooks(strFN & ".xls").PrintPreview
       
       XlApp.WindowState = -4140
   
   Call Process_Kill(strFN)

   On Error GoTo 0
   
   Exit Sub

XPreview_Error:

   On Error GoTo 0
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure XPreview of Module modExcel", , vbCritical
   
End Sub


'======================================================================================
' Procedure : XHighPos
' DateTime  : 2007-03-13 17:52
' Author    : 서은아빠 (foxmotor@nate.com)
' Purpose   : Excel의 미리보기 창을 최상위 윈도우루 설정
'======================================================================================
Public Sub MDIHighPos(Optional BLK As Boolean = True)
 Dim Top As Long
   On Error GoTo MDIHighPos_Error
       Top = IIf(BLK = True, HWND_TOPMOST, HWND_NOTOPMOST)
       SetWindowPos KMPMAIN.hwnd, Top, 0, 0, 0, 0, Flags

   On Error GoTo 0
   
   Exit Sub

MDIHighPos_Error:

   On Error GoTo 0
   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure MDIHighPos of Module modExcel", , vbCritical
End Sub

'======================================================================================
' Procedure : GetXlfile
' DateTime  : 2007-03-15 03:31
' Author    : 서은아빠 (foxmotor@nate.com)
' Purpose   : 프로세스가 살아있는 Excel파일을 ListUp
'======================================================================================
Public Sub GetXlfile(ByVal frmN As Form)
   Dim Xhwnd    As Long
   Dim lngRet   As Long
   Dim lngSpace As Long
   Dim strSpace As String
   Dim strXname As String
   Dim Buf      As String * 255
   
   frmN.Show vbModeless
   
   frmN.cbXl.Clear
   
   Xhwnd = GetTopWindow(0)   '### 바탕화면 다음 윈도우를 얻는다.
   
   Do
   
   Xhwnd = GetNextWindow(Xhwnd, GW_HWNDNEXT)   '### 바탕화면 다음 윈도우를 얻는다.
   
   strSpace = Space(128)                                 '### 적당한 공간 할당하구
   
   lngRet = GetClassName(Xhwnd, strSpace, 128)           '### 클래스명을 얻었다믄(lngRet<>0) 공터에다가 클래스명 처넣구
   
   If lngRet Then strSpace = Left(strSpace, lngRet)      '### 클래스명을 얻었다믄(lngRet<>0) 빈문자열 삭제하구선
   
   If strSpace = "XLMAIN" Then                           '### Excel 윈도우라면...
       
       lngSpace = GetWindowTextLength(Xhwnd)             '### 캡션 길이 구하구
       
       strXname = Space(lngSpace)                        '### 변수에 공간 할당
       
       Call GetWindowText(Xhwnd, strXname, lngSpace + 1) '### 숨기구나 보여주거나
       
       strXname = Mid(strXname, 19, Len(strXname)) ' & ".xls"
       
       frmN.cbXl.AddItem strXname
       
   End If                                                '### 아님 말구
   
   Loop While Xhwnd                                      '### 핸들값 존재하믄 계속 지루박 돌구
   
   frmN.cbXl.ListIndex = 0

End Sub 설문투표

자세한 내용은 http://msdn2.microsoft.com/en-us/library/Aa242137(VS.60).aspx 여기에 있습니다.

골자는

프로젝트 컴파일 하기전에 프로젝트 속성.... 일반 탭에 있는 아래 그림 참조

위 그림에서 처럼 빨간 테두리에 있는 것을 체크한 후, 컴파일을 하게 되면

OCX파일과 VBL파일이 생성됩니다.

VBL파일을 메모장으로 열어보시면 라이센스 키를 등록할 수 있는 레지스트리 내용이 나옵니다.

즉, 이것이 등록이 되야... OCX를 올려놓고 코딩할 수 있는 권한이 쥐어지는 것이죠..

단순 실행시에는 상관이 없습니다. 이 기능은 다른 회사나 다른 사용자가 자기 혹은 우리회사의 제품을

악의적으로 사용을 금하기 위한 조치입니다.

폼의 배경을 투명하게 만드는 코드입니다. 투명하게 만드는 코드라고는 하지만

실제적으론 투명하게 되는 것이 아니고 폼에 의해 가려진 윈도우의 배경을 폼의

배경화면으로 살짝 옮기는 것입니다. 테스트 하실때 일단 폼을 투명하게 하고

폼상단의 바를 클릭하여 드래그를 해보면 알수 있을 것입니다.

1. 모듈에 다음과 같은 API Function을 선언합니다

Public Const GWL_EXSTYLE = (-20)

Public Const WS_EX_NOTRANSPARENT = &H0&

Public Const WS_EX_TRANSPARENT = &H20&

Public Const SWP_FRAMECHANGED = &H20

Public Const SWP_NOMOVE = &H2

Public Const SWP_NOSIZE = &H1

Public Const SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE

Public Const HWND_NOTOPMOST = -2

Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _

       (ByVal hwnd As Long, _

        ByVal nIndex As Long, _

        ByVal dwNewLong As Long) As Long

Declare Function SetWindowPos Lib "user32" _

       (ByVal hwnd As Long, _

        ByVal hWndInsertAfter As Long, _

        ByVal x As Long, _

        ByVal y As Long, _

        ByVal cx As Long, _

        ByVal cy As Long, _

        ByVal wFlags As Long) As Long

2. 폼을 하나 추가시킨후 폼에 두개의 CommandButton 을 올려놓습니다.

   그리고 각각의 CommandButton 에 다음과 같이 코딩하십시요.

' 폼을 투명하게 만든다

Private Sub Command1_Click()

    SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT

    SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME

End Sub

' 폼을 원래대로 되돌린다

Private Sub Command1_Click()

    SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_NOTRANSPARENT

    SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME

    Me.Refresh

End Sub

3. 실행을 한후 CommandButton1 을 클릭하게 되면 폼이 투명하게 변하고

   CommandButton2 를 클릭하게 원래대로 되돌아 옵니다.

   폼을 투명하게 한후 폼상단의 바를 클릭하여 드래그 해보세요.

   그러면 위에서 이야기한 내용을 알게 될것입니다.