엑셀 실행시 VISUAL BASIC 프로그램 실행시키면서 컴파일 오류?
컨텐츠 정보
- 4,350 조회
- 3 댓글
- 목록
본문
엑셀 실행할때마다 VISUAL BASIC 프로그램 이 켜지면서
컴파일 오류입니다.
이 프로젝트 코드를 업데이트해야 64비트 시스템에서 사용할수 있습니다.
Delclare 문을 검토하고 업데이트 한 다음 PtrSafe 특성으로 표시하십시오.
Public Type udtType
iData As Integer
bData(0 To 9) As Byte
End Type
Public Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
ByVal source As Long, _
ByVal length As Long)
Public Const GWL_WNDPROC = -4
Public Const WM_COPYDATA = &H4A
Public Const WM_SYSCOMMAND = &H112
Public Const SC_CLOSE = &HF060&
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Global lpPrevWndProc As Long
Global gHW As Long
Public Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Public Declare Function PostMessageA Lib "user32" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim g_bHook As Boolean
Dim g_blnTimer As Boolean
Dim g_lngTimerID As Long
Dim g_hApplicationWnd As Long
Dim g_sFindStr As String
Dim g_sWritePos As String
Dim g_sFindPos As String
Dim g_xlApp As Excel.Application
Dim g_xlBook As Excel.Workbook
Dim g_noClick As Boolean
Dim AppClass As New ApplicationClass
Public Sub AppClassInit()
Set g_xlApp = ThisWorkbook.Application
Set g_xlBook = g_xlApp.ActiveWorkbook
If AppClass.g_bFirst <> True Then
Set AppClass.AppEvents = g_xlBook.ActiveSheet.Application
AppClass.g_bFirst = True
End If
End Sub
Public Sub Hook()
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)
g_bHook = True
End Sub
Public Sub UnHook()
Dim lngReturnValue As Long
lngReturnValue = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
g_bHook = False
End Sub
Function WindowProc(ByVal hw As Long, _
ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
If uMsg = WM_SYSCOMMAND And wParam = SC_CLOSE Then
Call UnHook
Call PostMessageA(gHW, WM_SYSCOMMAND, SC_CLOSE, 0&)
Exit Function
End If
Select Case uMsg
Case WM_COPYDATA
Dim cds As COPYDATASTRUCT ' udtType은 WM_COPYDATA로 전달 받는 Data 형식이다.
Dim udt As udtType ' COPYDATASTRUCT 복사
' 데이터 복사
CopyMemory cds, lParam, Len(cds)
If cds.dwData = -1 Then ' 종료
Call UnHook
Exit Function
End If
'CopyMemory udt, cds.lpData, cds.cbData
Dim buf(1 To 255) As Byte
Call CopyMemory(buf(1), ByVal cds.lpData, cds.cbData)
Dim sString As String
sString = StrConv(buf, vbUnicode)
If cds.dwData = 1 Then ' DDE 전송전 정보
Dim sData As String
sData = sString
Dim nCodePosition As Integer
Dim sCol As String
sCol = Left(sData, 1) ' Col 갯수
Dim nCol As Integer
nCol = CInt(sCol)
nCodePosition = 1
sData = Mid(sData, 2)
Dim nPos As Integer
nPos = InStr(sData, "@")
Dim sSheet As String
sSheet = Left(sData, nPos - 1) ' Sheet
Dim nSheet As Integer
nSheet = CInt(sSheet)
nCodePosition = nCodePosition + nPos
sData = Mid(sData, nPos + 1)
nPos = InStr(sData, "@")
nCodePosition = nCodePosition + nPos
Dim sRange As String
sRange = Left(sData, nPos - 1) ' 위치
Dim sCode As String
Dim nLen As Integer
nLen = cds.cbData - nCodePosition
sCode = Mid(sData, nPos + 1, nLen) ' 코드
'sCode = Mid(sData, nPos + 1) ' 코드
Call AppClass.SetChegulInfo(sRange, nSheet, sCode, nCol)
End If
sString = ""
Case Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
End Select
End Function
Public Function Search_Chegul(sFins As String, sPos As String)
Search_Chegul = ""
g_sFindStr = sFins
g_sWritePos = sPos
If g_blnTimer = False Then
g_blnTimer = True
g_lngTimerID = SetTimer(0, 0, 10, AddressOf TimerProc_SearchChegul)
If g_lngTimerID = 0 Then
Exit Function
End If
End If
End Function
Public Sub TimerProc_SearchChegul(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
g_lngTimerID = KillTimer(0, g_lngTimerID)
g_blnTimer = False
SearchChegul
End Sub
Public Function SearchChegul()
Application.Cursor = xlWait
g_sFindPos = ""
Set g_xlApp = ThisWorkbook.Application
Set g_xlBook = g_xlApp.ActiveWorkbook
Dim nSheetCnt As Integer
nSheetCnt = g_xlBook.Sheets.Count
For i = 1 To nSheetCnt
Dim xlSheet As Excel.Worksheet
Set xlSheet = g_xlBook.Sheets(i)
Set RangeObj = xlSheet.Cells.Find(What:=g_sFindStr, LookIn:=xlFormulas)
If Not RangeObj Is Nothing Then
firstAddress = RangeObj.Address
Do
Set RangeObj = xlSheet.Cells.FindNext(RangeObj)
If Not RangeObj Is Nothing Then
sPos = RangeObj.Address
g_sFindPos = g_sFindPos + Str(i) + ";" + sPos + ","
End If
Loop While Not RangeObj Is Nothing And RangeObj.Address <> firstAddress
'Range(firstAddress).Offset(-1, 0).Select
End If
Next i
xlSheet.Range(g_sWritePos).Value = g_sFindPos
Application.Cursor = xlNoRestrictions
End Function
Public Function GetHWnd()
Application.Cursor = xlWait
g_hApplicationWnd = g_xlApp.hwnd
GetHWnd = g_hApplicationWnd
Application.Cursor = xlNoRestrictions
End Function
Public Function SetHook()
SetHook = ""
If g_bHook = True Then
Exit Function
End If
If g_blnTimer = False Then
g_blnTimer = True
g_lngTimerID = SetTimer(0, 0, 10, AddressOf TimerProc_SetHook)
If g_lngTimerID = 0 Then
Exit Function
End If
End If
End Function
Public Function SetUnHook()
SetUnHook = ""
If g_bHook = True Then
Exit Function
End If
If g_blnTimer = False Then
g_blnTimer = True
g_lngTimerID = SetTimer(0, 0, 10, AddressOf TimerProc_SetUnHook)
If g_lngTimerID = 0 Then
Exit Function
End If
End If
End Function
Public Sub TimerProc_SetHook(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
g_lngTimerID = KillTimer(0, g_lngTimerID)
g_blnTimer = False
Call CallHook
End Sub
Public Sub TimerProc_SetUnHook(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
g_lngTimerID = KillTimer(0, g_lngTimerID)
g_blnTimer = False
Call CallUnHook
End Sub
Public Function CallHook()
If g_bHook = True Then
Exit Function
End If
'gHW = g_hApplicationWnd
gHW = g_xlApp.hwnd
g_bHook = True
Call Hook
End Function
Public Function CallUnHook()
g_bHook = False
Call UnHook
'Call PostMessageA(gHW, WM_SYSCOMMAND, SC_CLOSE, 0&)
End Function
Public Function DisplayTitle(sTitle As String)
DisplayTitle = sTitle
End Function
Public Function RTDInterval()
RTDInterval = ""
Application.RTD.ThrottleInterval = 0
End Function
관련자료
주수리님의 댓글
여시려는 파일이 xlsm이고 매크로에 문제가 있는 것이라면 우선 이 매크로가 뭔지부터 설명을 주셔야 할 것 같네요. 코드만 던져주고 알아서 고쳐줘 이런 느낌이라 어렵네요. 심지어 주석도 없는 코드를요....
일단 생각되는 것은 해당 매크로는 32비트 기준으로 작성되었고 현재 64비트여서 발생하는 문제로 보여집니다. 오피스를 32비트로 까시면 해결될 것 같네요.