代码修正：Option Explicit Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long Private Declare PtrSafe Function EmptyClipboard Lib32" () As Long Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Const CF_BITMAP = 2 Private Const SRCCOPY = &HCC0020

抱歉，我之前给出的代码有一些错误。以下是修正后的代码：

Option Explicit

Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As LongPtr
Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr
Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As LongPtr, ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As Long

Private Const CF_BITMAP = 2
Private Const SRCCOPY = &HCC0020

Sub CaptureRangeAsImage(rng As Range, filePath As String)
    Dim ws As Worksheet
    Dim hwnd As LongPtr
    Dim hdcSrc As LongPtr
    Dim hdcDest As LongPtr
    Dim hBitmap As LongPtr
    Dim leftPos As Long
    Dim topPos As Long
    Dim width As Long
    Dim height As Long
    
    Set ws = rng.Worksheet
    hwnd = Application.hwnd
    
    ' 获取源设备上下文
    hdcSrc = GetDC(0)
    
    ' 创建兼容的目标设备上下文
    hdcDest = CreateCompatibleDC(hdcSrc)
    
    ' 获取要保存的区域的位置和尺寸
    leftPos = rng.Left
    topPos = rng.Top
    width = rng.Width
    height = rng.Height
    
    ' 创建兼容位图
    hBitmap = CreateCompatibleBitmap(hdcSrc, width, height)
    
    ' 将兼容位图选入目标设备上下文
    SelectObject hdcDest, hBitmap
    
    ' 使用 BitBlt 函数将源设备上下文中的内容复制到目标设备上下文中
    BitBlt hdcDest, 0, 0, width, height, hdcSrc, leftPos, topPos, SRCCOPY
    
    ' 将位图保存到剪贴板
    OpenClipboard hwnd
    EmptyClipboard
    SetClipboardData CF_BITMAP, hBitmap
    CloseClipboard
    
    ' 保存剪贴板中的位图为图片文件
    SavePicture GetClipboardImage(), filePath
    
    ' 释放创建的对象和资源
    DeleteObject hBitmap
    DeleteDC hdcDest
    ReleaseDC hwnd, hdcSrc
End Sub

Function GetClipboardImage() As IPicture
    Dim dataObj As DataObject
    Set dataObj = New DataObject
    
    dataObj.GetFromClipboard
    Set GetClipboardImage = dataObj.GetImage
End Function

在上述代码中，我们修正了 API 函数的声明，并进行了一些其他的调整。`CaptureRangeAsImage` 过程用于将指定区域的内容保存为图片，然后通过 `SavePicture` 将剪贴板中的位图保存为图片文件。

请注意，为了获取剪贴板中的位图，我们定义了 `GetClipboardImage` 函数，该函数使用 `DataObject` 类获取剪贴板上的图像。

希望这次能够帮助到您！如果您有任何其他问题，请随时提问。