1. 아별툴
  2. 아별툴 패밀리
  3. 엑셀 질문하기
  4. 엑셀 강좌
  5. 엑셀 팁
  6. 엑셀 자료실
  7. 엑셀 연구과제
  8. 엑셀 북마크
  9. 관련 프로그램 소개

[레벨:30]아별

2017.04.06 23:42

많이 사용하는 API함수를 64비트에서 사용할 수 있도록 코드를 제공한 사이트가 있어 링크합니다.

From. http://www.jkp-ads.com/articles/apideclarations.asp


FindWindow
Private Declare Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As StringByVallpWindowName As StringAs Long

Private
 Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String,ByVal lpWindowName As StringAs LongPtr
FindWindowEx
Private Declare Function FindWindowEx Lib "USER32" _
                                  Alias "FindWindowExA" (ByVal hWnd1 As LongByVal hWnd2 As Long, _
                                  ByVal lpsz1 As StringByVal lpsz2 As StringAs Long

Private
 Declare PtrSafe Function FindWindowEx Lib "USER32" _
                                  Alias "FindWindowExA" (ByVal hWnd1 As LongPtrByVal hWnd2 As LongPtr, _
                                  ByVal lpsz1 As StringByVal lpsz2 As StringAs LongPtr
GdipCreateBitmapFromFile
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As LongAsLong

Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmapAs LongPtr) As LongPtr
GdipCreateHBITMAPFromBitmap
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long,ByVal background As LongAs Long

Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As Long) As LongPtr
GdipDisposeImage
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongAs Long

Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As LongPtr
GdiplusShutdown
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongAs Long

Private Declare PtrSafe Function GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr) As LongPtr
GdiplusStartup
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput,Optional ByVal outputbuf As Long = 0) As Long
Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type
    
Private Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf AsGdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As LongPtr

Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As LongPtr
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type
GetClassName
Public Declare Function GetClassName Lib "USER32" Alias "GetClassNameA" _
                                     (ByVal hWnd As Long, ByVal lpClassName As String, _
                                      ByVal nMaxCount As LongAs Long

Public Declare PtrSafe Function GetClassName Lib "USER32" Alias "GetClassNameA" _
                                     (ByVal hWnd As LongPtrByVal lpClassName As String, _
                                      ByVal nMaxCount As LongPtrAs Long
GetDiskFreeSpaceEx
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" _
    Alias "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
    lpFreeBytesAvailableToCaller As Currency, _
    lpTotalNumberOfBytes As Currency, _
    lpTotalNumberOfFreeBytes As CurrencyAs Long
Private Declare PtrSafe Function GetDiskFreeSpaceEx Lib "kernel32" Alias _
    "GetDiskFreeSpaceExA" (ByVal lpDirectoryName As String, _
    lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As _
    Currency, lpTotalNumberOfFreeBytes As CurrencyAs LongPtr
getDC
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As LongAs Long

Private
 Declare PtrSafe Function GetDC Lib "USER32" (ByVal hWnd As LongPtrAs LongPtr
GetDesktopWindow
Public Declare Function GetDesktopWindow Lib "USER32" () As Long

Public Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
getDeviceCaps
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongByVal nIndex As LongAs Long

Private
 Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtrByVal nIndex As LongAsLong
GetDriveType
Private Declare Function GetDriveType Lib "kernel32" Alias _
                        "GetDriveTypeA" (ByVal sDrive As StringAs Long

Private Declare PtrSafe Function GetDriveType Lib "kernel32" Alias _
                                "GetDriveTypeA" (ByVal sDrive As String) As LongPtr
GetExitCodeProcess
#If VBA7 Then
    Declare PtrSafe Function GetExitCodeProcess Lib "kernel32" (ByVal _
        hProcess As LongPtr, lpExitCode As LongAs Long
#Else
    Declare Function GetExitCodeProcess Lib "kernel32" (ByVal _
        hProcess As Long, lpExitCode As LongAs Long
#End If
GetForegroundWindow
Declare Function GetForegroundWindow Lib "user32.dll" () As Long

Declare PtrSafe Function GetForegroundWindow Lib "user32.dll" () As LongPtr
getFrequency
Declare Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As CurrencyAsLong

Private
 Declare PtrSafe Function getFrequency Lib "kernel32" Alias "QueryPerformanceFrequency" (cyFrequency As CurrencyAs Long
GetKeyState
Declare Function GetKeyState Lib "USER32" (ByVal vKey As LongAs Integer

Declare
 PtrSafe Function GetKeyState Lib "USER32" (ByVal vKey As LongAs Integer
GetLastInputInfo
#If VBA7 Then
    Private Type LASTINPUTINFO
        cbSize As LongPtr
        dwTime As LongPtr
    End Type
    Private Declare PtrSafe Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#Else
    Private Type LASTINPUTINFO
        cbSize As Long
        dwTime As Long
    End Type
    Private Declare Sub GetLastInputInfo Lib "USER32" (ByRef plii As LASTINPUTINFO)
#End If
GetOpenFileName
Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
            "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
       
    Public Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As LongPtr
        lpTemplateName As String
    End Type
   
#Else

    Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
            "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
       
    Public Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
#End If
'/////////////////////////////////
'// End code GetOpenFileName    //
'/////////////////////////////////


Public Function GetMyFile(strTitle As StringAs String

    Dim OpenFile    As OPENFILENAME
    Dim lReturn     As Long
   
    OpenFile.lpstrFilter = ""
    OpenFile.nFilterIndex = 1
    OpenFile.hwndOwner = 0
    OpenFile.lpstrFile = String(257, 0)
    #If VBA7 Then
        OpenFile.nMaxFile = LenB(OpenFile.lpstrFile) - 1
        OpenFile.lStructSize = LenB(OpenFile)
    #Else
        OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
        OpenFile.lStructSize = Len(OpenFile)
    #End If
    OpenFile.lpstrFileTitle = OpenFile.lpstrFile
    OpenFile.nMaxFileTitle = OpenFile.nMaxFile
    OpenFile.lpstrInitialDir = "C:\"
    OpenFile.lpstrTitle = strTitle
    OpenFile.flags = 0
    lReturn = GetOpenFileName(OpenFile)
   
    If lReturn = 0 Then
        GetMyFile = ""
    Else
        GetMyFile = Trim(Left(OpenFile.lpstrFile, InStr(1, OpenFile.lpstrFile, vbNullChar) - 1))
    End If
   
End Function

GetSystemMetrics
Private Declare Function GetSystemMetrics Lib "USER32" (ByVal nIndex As LongAs Long

Private
 Declare PtrSafe Function GetSystemMetrics Lib "USER32" (ByVal nIndex As LongAs Long
GetTempPath
Declare Function GetTempPath Lib "kernel32" _
                             Alias "GetTempPathA" (ByVal nBufferLength As Long, _
                                                   ByVal lpbuffer As StringAs Long

Declare PtrSafe Function GetTempPath Lib "kernel32" _
                             Alias "GetTempPathA" (ByVal nBufferLength As longptr, _
                                                   ByVal lpbuffer As String) As Long
getTickCount
Private Declare Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount AsCurrencyAs Long

Private
 Declare PtrSafe Function getTickCount Lib "kernel32" Alias "QueryPerformanceCounter" (cyTickCount AsCurrencyAs Long
    '
getTime
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private
 Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long
GetWindow
Public Declare Function GetWindow Lib "USER32" _
                                  (ByVal hWnd As LongByVal wCmd As LongAs Long

Public Declare PtrSafe Function 
GetWindow Lib "USER32" _
                                  (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
GetWindowLongThis is one of the few API functions that requires the Win64 compile constant:
#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As LongAs LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd AsLongPtr, ByVal nIndex As LongAs LongPtr
    #End If
#Else
    Private Declare Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByValnIndex As LongAs Long 
#End If
GetWindowsDirectory
Declare Function GetWindowsDirectory& Lib "kernel32" Alias _
                                      "GetWindowsDirectoryA" (ByVal lpbuffer As String_
                                                              ByVal
 nSize As Long)

Declare PtrSafe Function GetWindowsDirectory& Lib "kernel32" Alias _
                                      "GetWindowsDirectoryA" (ByVal lpbuffer As String_
                                                              ByVal
 nSize As LongPtr)
GetWindowText
Public Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
                                      (ByVal hWnd As LongByVal lpString As String, _
                                       ByVal cch As LongAs Long

Public Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
                                      (ByVal hWnd As LongPtr, ByVal lpString As String, _
                                       ByVal cch As LongPtr) As Long
InternetGetConnectedState
Public Declare Function InternetGetConnectedState _
        Lib "wininet.dll" (lpdwFlags As Long, _
        ByVal dwReserved As LongAs Boolean

Public Declare PtrSafe Function InternetGetConnectedState _
        Lib "wininet.dll" (lpdwFlags As LongPtr, _
        ByVal dwReserved As long) As Boolean
IsCharAlphaNumericA
Private Declare Function IsCharAlphaNumericA Lib "USER32" (ByVal byChar As ByteAs Long

Private
 Declare PtrSafe Function IsCharAlphaNumericA Lib "USER32" (ByVal byChar As ByteAs Long
OleCreatePictureIndirect
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Private Type PICTDESC
    Size As Long
    Type As Long
    hPic As Long
    hPal As Long
End Type

Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr

Private Type PICTDESC
    Size As Long
    Type As Long
    hPic As LongPtr
    hPal As LongPtr
End Type
OpenProcess
#If VBA7 Then
    Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal _
        dwDesiredAccess As LongByVal bInheritHandle As Long, ByVal _
        dwProcessId As LongAs LongPtr
#Else
    Declare Function OpenProcess Lib "kernel32" (ByVal _
        dwDesiredAccess As LongByVal bInheritHandle As Long, ByVal _
        dwProcessId As LongAs Long
#End If
ReleaseDC
Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As LongByVal hDC As LongAs Long

Private
 Declare PtrSafe Function ReleaseDC Lib "USER32" (ByVal hWnd As LongPtrByVal hDC As LongPtr) As Long
SendMessage
Public Declare Function SendMessageA Lib "user32" (ByVal hWnd As LongByVal wMsg As Long, _
                                                   ByVal wParam As Long, lParam As Any) As Long
Public Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hWnd As LongPtrByVal wMsg As Long, _
                                                           ByVal wParam As LongPtr, lParam As Any) As LongPtr
SetActiveWindow
Declare Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As LongAs Long

Declare PtrSafe Function SetActiveWindow Lib "user32.dll" (ByVal hWnd As LongPtrAs LongPtr
SetCurrentDirectory
Private Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As StringAs Long

Private
 Declare PtrSafe Function SetCurrentDirectoryA Lib "kernel32" (ByVal lpPathName As StringAs Long
SetWindowLongPtrThis is one of the few API functions that requires the Win64 compile constant:
#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As LongByVal dwNewLong As LongPtrAs LongPtr
    #Else
        Private Declare Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd AsLongPtr, ByVal nIndex As LongByVal dwNewLong As LongPtrAs LongPtr
    #End If
#Else
    Private Declare Function SetWindowLongPtr Lib "USER32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByValnIndex As LongByVal dwNewLong As LongAs Long 
#End If
SHBrowseForFolder
#If VBA7 Then
    Private Type BROWSEINFO
        hOwner As LongPtr
        pidlRoot As LongPtr
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As LongPtr
        lParam As LongPtr
        iImage As Long
    End Type
                        
    Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As LongPtr
#Else
    Private Type BROWSEINFO
        hOwner As Long
        pidlRoot As Long
        pszDisplayName As String
        lpszTitle As String
        ulFlags As Long
        lpfn As Long
        lParam As Long
        iImage As Long
    End Type
                        
    Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _
        (lpBrowseInfo As BROWSEINFO) As Long
#End If
Private Const BIF_RETURNONLYFSDIRS = &H1
ShellExecute
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
        ByVal hwnd As LongByVal lpOperation As StringByVal lpFile As String, _
        ByVal lpParameters As StringByVal lpDirectory As StringByVal nShowCmd As LongAs Long

Private
 Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
        ByVal hwnd As LongPtrByVal lpOperation As StringByVal lpFile As String, _
        ByVal lpParameters As StringByVal lpDirectory As StringByVal nShowCmd As LongAs LongPtr
SHFileOperation
#If VBA7 Then
    Type SHFILEOPSTRUCT
        hWnd As LongPtr
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAborted As Boolean
        hNameMaps As Longptr
        sProgress As String
    End Type
    Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
                                     (lpFileOp As SHFILEOPSTRUCT) As LongPtr
#Else
    Type SHFILEOPSTRUCT
        hWnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAborted As Boolean
        hNameMaps As Long
        sProgress As String
    End Type
    Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _
                                     (lpFileOp As SHFILEOPSTRUCT) As Long
#End If
SHGetPathFromIDList
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
        (ByVal pidl As LongByVal pszPath As StringAs Boolean

Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
        (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean
SHGetSpecialFolderLocation
    Private Declare Function SHGetSpecialFolderLocation Lib _
        "shell32.dll" (ByVal hwndOwner As LongByVal nFolder As Long, _
        pidl As ITEMIDLIST) As Long

    Private Declare PtrSafe Function SHGetSpecialFolderLocation Lib _
        "shell32.dll" (ByVal hwndOwner As LongPtr, ByVal nFolder As Long, _
        pidl As ITEMIDLIST) As LongPtr

    Private Type SHITEMID
        cb As Long
        abID As Byte
     End Type
     Private Type ITEMIDLIST
        mkid As SHITEMID
     End Type
timeGetTime
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private
 Declare PtrSafe Function timeGetTime Lib "winmm.dll" () As Long





문서 첨부 제한 : 0Byte/ 2.00MB
파일 제한 크기 : 2.00MB (허용 확장자 : *.*)