最近你很努力呀！嘿嘿

呵呵，手机5-13号被不认识的同校同学捡了，然后就没换给我，现在都不知道怎么办，心里憋屈，所以就不停地写程序。。。。这个解释很意外吧！

不需调用API函数也能自动更换桌面的，但必须清楚知道桌面图片的存放路径

[quote]不需调用API函数也能自动更换桌面的，但必须清楚知道桌面图片的存放路径[/quote]
哦？怎样弄？

下面是窗体代码：
Option Explicit

Dim fs, fo, ws
Dim i As Long, Register As String, Wallpaper As String, UserPath As String, z2 As String

Private Sub Form_Load()
On Error Resume Next
Dim BJ As Boolean
Set fs = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("wscript.shell")

z2 = ws.SpecialFolders("Startup") & "\王牌桌面魔术师.lnk" '获取“启动”文件夹路径
UserPath = Environ("USERPROFILE")                        '获取用户文件夹路径
UserPath = UserPath & "\Local Settings\Application Data\Microsoft\Wallpaper1.bmp"
Register = "HKCU\Control Panel\Desktop\"

i = ws.regread(Register & "下次墙纸序号"): If Err.Number > 0 Then GoTo 100         '无此项值退出
Wallpaper = ws.regread(Register & "墙纸图片路径"): If Err.Number > 0 Then GoTo 100 '无此项值退出
Set fo = fs.GetFolder(Wallpaper): If Err.Number > 0 Then GoTo 100                 '无此文件夹退出

File1.Path = Wallpaper
File1.ListIndex = IIf(i >= File1.ListCount - 1, 0, i + 1)
Wallpaper = File1.Path & "\" & File1.FileName
If Len(Dir(Wallpaper)) = 0 Then MsgBox "王牌桌面魔术师找不到这个文件：" & Wallpaper & vbCrLf & "下次仍将使用本次的图片作为桌面", , "友情提示": BJ = True

If Not BJ Then If Not 写注册表 Then GoTo 100
If Len(Dir(z2)) = 0 Then 创建快捷方式
Unload Me
End
Exit Sub

100
Err.Number = 0: Me.Visible = True
End Sub

Function 写注册表() As Boolean
On Error GoTo 100

If Right(UCase(Wallpaper), 3) = "BMP" Then
  fs.CopyFile Wallpaper, UserPath, True
Else '将jpg gif 转为bmp并保存
  Pic.Picture = LoadPicture(Wallpaper)
  SavePicture Pic.Image, UserPath
End If

ws.regwrite Register & "下次墙纸序号", File1.ListIndex, "REG_DWORD"
ws.regwrite Register & "ConvertedWallpaper", Wallpaper

写注册表 = True
100
End Function

Private Sub 确定键_Click()
On Error GoTo 100
If File1.FileName = "" Then MsgBox "需要选择一个图片文件": Exit Sub
If Len(Dir(z2)) = 0 Then 创建快捷方式

Register = "HKCU\Control Panel\Desktop\"
ws.regwrite Register & "Wallpaper", UserPath
ws.regwrite Register & "OriginalWallpaper", UserPath
ws.regwrite Register & "墙纸图片路径", File1.Path '写入墙纸图片路径
If Not 写注册表 Then MsgBox "操作失败": GoTo 100
Unload Me
End
Exit Sub
100
MsgBox "发生错误"
End Sub

Sub 创建快捷方式()
Set fo = ws.CreateShortcut(z2) '在“启动”中创建快捷方式
fo.TargetPath = App.Path & "\王牌桌面魔术师.exe" '设置快捷方式的目标程序
fo.WorkingDirectory = App.Path  '设置工作目录
fo.IconLocation = App.Path & "\王牌桌面魔术师.exe, 0" '设置图标
fo.WindowStyle = 1 '设置风格为常规
'fo.Hotkey = "" '设置快捷键
fo.Description = "更换墙纸后自动退出" '添加注释
fo.Save
Set fo = Nothing
End Sub
    
Private Sub Drive1_Change()
On Error GoTo 10
Dir1.Path = Drive1.Drive
Exit Sub
10
If Err.Number = 68 Then Drive1.Drive = Dir1.Path
Err.Number = 0
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub File1_Click()
Wallpaper = File1.Path & "\" & File1.FileName
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set fs = Nothing
Set ws = Nothing
End
End Sub

Private Sub 取消键_Click()
Unload Me
End Sub

Private Sub 帮助键_Click()
Dim Hp As String
Hp = "1.必须建立一个墙纸图片的专用文件夹，图片文件类型是jpg、bmp、gif" & vbCrLf
Hp = Hp & "2.如果是第一次使用，会自动在“启动”中创建一个快捷方式" & vbCrLf
Hp = Hp & "3.本程序在后台运行，并在更换墙纸图片后自动退出" & vbCrLf
Hp = Hp & "4.本设置画面只在第一次使用时出现。如果以后要再次设置，只需将专用" & vbCrLf
Hp = Hp & "　文件夹改名，再点击本程序的图标，即可出现这个设置画面"
MsgBox Hp, , "帮助"
End Sub

窗体上需添加7个控件：3个按纽、1个图片框、1个文件列表框、1个驱动器列表框、1个目录列表框。窗体设置为不可见

哦，手机问题。打电话给他讨要，是在不还也就算了。想开些。

恩！

NOT all that Mrs. Bennet, however, with the assistance of [url=http://www.timberlandforyou.com/]mens timberland boots[/url] her five daughters, could ask on the subject was sufficient to draw from her husband any satisfactory description of Mr. Bingley. They attacked him in various ways; with [url=http://www.timberlandforyou.com/]timberland 6 inch boots[/url] barefaced questions, ingenious suppositions, and distant surmises; but he eluded the skill of them all; and they were at last obliged to accept the second-hand intelligence of their [url=http://www.timberlandforyou.com/]timberland roll top[/url] neighbour Lady Lucas. Her report was highly favourable. Sir William had been delighted with him. He was quite young, wonderfully [url=http://www.timberlandforyou.com/]timberland roll top boot[/url] handsome, extremely agreeable, and, to crown the whole, he meant to be at the next assembly with a large party. Nothing could be more delightful! To be fond of dancing was a certain step towards [url=http://www.timberlandforyou.com/]timberland roll top boot[/url] falling in love; and very lively hopes of Mr. Bingley's heart were entertained.;If I can but see one of my daughters happily settled at Netherfield,; said Mrs. Bennet to her husband, ;and all the others [url=http://www.timberlandforyou.com/]Womens 14-Inch Premium Waterproof Boots[/url] equally well married, I shall have nothing to wish for.;In a few days Mr. Bingley returned Mr. Bennet's visit, and sat about ten minutes with him in his library. He had entertained [url=http://www.timberlandforyou.com/]shop timberland boots[/url] hopes of being admitted to a sight of the young ladies, of whose beauty he had heard much; but he saw only the father. The ladies were somewhat more fortunate, for they had the advantage [url=http://www.timberlandforyou.com/]timberland men boots[/url] of ascertaining, from an upper window, that he wore a blue coat and rode a black horse.An invitation to dinner was soon afterwards dispatched; and already had Mrs. Bennet planned the courses that were [url=http://www.timberlandforyou.com/]timberlands boots[/url] to do credit to her housekeeping, when an answer arrived which deferred it all. Mr. Bingley was obliged to be in town the following day, and consequently unable to accept the honour of their [url=http://www.timberlandforyou.com/]timberland boots on sale[/url] invitation, c. Mrs. Bennet was quite disconcerted. She could not imagine what business he could have in town so soon after his arrival in Hertfordshire; and she began to fear that he might [url=http://www.timberlandforyou.com/]cheap timberland boots[/url] be always flying about from one place to another, and never settled at Netherfield as he ought to be. Lady Lucas quieted her fears a little by starting the idea of his being gone to London only to [url=http://www.timberlandforyou.com/]timberland boots on sale[/url] get a large party for the ball; and a report soon followed that Mr. Bingley was to bring twelve ladies and seven gentlemen with him [url=http://www.timberlandforyou.com/]womens timberland boots[/url] to the assembly.
[url=http://www.timberlandforyou.com/]timberland 14 inch boots[/url] 
[url=http://www.timberlandforyou.com/]timberland working boots[/url] 
[url=http://www.timberlandforyou.com/]mens timberland boots[/url] zxj

你坑爹！！