자바스크립트를 허용해주세요.
[ 자바스크립트 활성화 방법 ]
from Mohon Aktifkan Javascript!
질문 분류

엑셀 실행시 VISUAL BASIC 프로그램 실행시키면서 컴파일 오류?

컨텐츠 정보

본문

엑셀 실행할때마다 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


관련자료



댓글 3 / 1 페이지

주수리님의 댓글

엑셀 자체의 문제가 아니라 사용자 매크로의 문제로 보이는데요. 혹시 그냥 일반적으로 빈시트를 열었을때도 발생하신다면 ms사이트에 클린삭제 툴로 office를 깨끗하게 제거하신 후에 재설치 하시는게 빠를것같구요.
여시려는 파일이 xlsm이고 매크로에 문제가 있는 것이라면 우선 이 매크로가 뭔지부터 설명을 주셔야 할 것 같네요. 코드만 던져주고 알아서 고쳐줘 이런 느낌이라 어렵네요. 심지어 주석도 없는 코드를요....
일단 생각되는 것은 해당 매크로는 32비트 기준으로 작성되었고 현재 64비트여서 발생하는 문제로 보여집니다. 오피스를 32비트로 까시면 해결될 것 같네요.

얌교님의 댓글의 댓글

오! 사실 뭘 어떻게 물어볼지 몰라서 그냥 있는데로 갔다 붙여놨어요
32비트 64비트 문제인거 같은데... 감사합니다.
다시 설치해야겠네요 ㅠ
전체 3,840 / 82 페이지
번호
제목
이름