64位系统无法运行之前的VBA代码

ljt1015

这是一个把excel页面内容快速截图并设置为电脑桌面的VBA脚本，换了64位系统之后就无法运行了，有没有高手帮忙修改一下。谢谢啦！




Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
    (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
Const SPI_SETDESKWALLPAPER = 20, SPIF_UPDATEINIFILE = &H1
Sub ChangeDesktop()
    Dim rng As Range, sp As Shape
    'Set rng = Application.InputBox("请选择单元格", "系统提示!", Type:=8)
    Set rng = [a1:bx42]
    rng.Copy: ActiveSheet.Pictures.Paste
    For Each sp In ActiveSheet.Shapes
        If sp.Type = 13 Then
            sp.CopyPicture
            With ActiveSheet.ChartObjects.Add(0, 0, sp.Width, sp.Height).Chart
                .Parent.Select
                .Paste
                .Export "C:\Users\T\Pictures\Camera Roll\Desktop.jpg", "jpg"
                .Parent.Delete
            End With
            sp.Delete
        End If
    Next
    Call SystemParametersInfo(ByVal SPI_SETDESKWALLPAPER, True, _
    ByVal "C:\Users\T\Pictures\Camera Roll\Desktop.jpg", SPIF_UPDATEINIFILE)
End Sub

Jaofuan

1. #If Win64 Then
   
2.     Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
   
3. #Else
   
4.     Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
   
5.         (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long
   
6. #End If
   
7. 
   
8. Const SPI_SETDESKWALLPAPER = 20, SPIF_UPDATEINIFILE = &H1
   
9. Sub ChangeDesktop()
   
10.     Dim rng As Range, sp As Shape
    
11.     'Set rng = Application.InputBox("请选择单元格", "系统提示!", Type:=8)
    
12.     Set rng = [a1:bx42]
    
13.     rng.Copy: ActiveSheet.Pictures.Paste
    
14.     For Each sp In ActiveSheet.Shapes
    
15.         If sp.Type = 13 Then
    
16.             sp.CopyPicture
    
17.             With ActiveSheet.ChartObjects.Add(0, 0, sp.Width, sp.Height).Chart
    
18.                 .Parent.Select
    
19.                 .Paste
    
20.                 .Export "C:\Users\T\Pictures\Camera Roll\Desktop.jpg", "jpg"
    
21.                 .Parent.Delete
    
22.             End With
    
23.             sp.Delete
    
24.         End If
    
25.     Next
    
26.     Call SystemParametersInfo(ByVal SPI_SETDESKWALLPAPER, True, _
    
27.     ByVal "C:\Users\T\Pictures\Camera Roll\Desktop.jpg", SPIF_UPDATEINIFILE)
    
28. End Sub

复制代码