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 설문투표
