代码如下：

Dim X As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim hs As Integer
'翻到最后一页，再下翻一页，填写新记录
Private Sub CmdAdd_Click()
CmdNew.Visible = True
CmdPic.Visible = True
X = LblShow.Caption
Do While xlSheet.Cells(X, 1) <> ""
X = X + 1
Loop
LblShow.Caption = X
Txt1.Text = ""
Txt2.Text = ""
Txt3.Text = ""
PicShow = LoadPicture(Txt3.Text)
PicShow.AutoSize = True

End Sub
'删除当前记录，并跳转到前一条记录
Private Sub CmdDelete_Click()
X = LblShow.Caption
xlSheet.Rows(X).Delete
Do While xlSheet.Cells(X + 1, 1) <> ""
X = X + 1
Loop
Txt1.Text = xlSheet.Cells(X - 1, 1)
Txt2.Text = xlSheet.Cells(X - 1, 2)
Txt3.Text = xlSheet.Cells(X - 1, 3)
PicShow = LoadPicture(xlSheet.Cells(X - 1, 3))
PicShow.AutoSize = True
LblShow.Caption = X - 1
End Sub

' 查看末记录
Private Sub CmdEnd_Click()
CmdNew.Visible = False
CmdPic.Visible = False
X = LblShow.Caption
Do While xlSheet.Cells(X, 1) <> ""
X = X + 1
Loop
Txt1.Text = xlSheet.Cells(X - 1, 1)
Txt2.Text = xlSheet.Cells(X - 1, 2)
Txt3.Text = xlSheet.Cells(X - 1, 3)
PicShow = LoadPicture(xlSheet.Cells(X - 1, 3))
PicShow.AutoSize = True
LblShow.Caption = X - 1
End Sub
' 向EXCEL中写数据
Private Sub CmdNew_Click()
xlSheet.Cells(X, 1) = Txt1.Text
xlSheet.Cells(X, 2) = Txt2.Text
xlSheet.Cells(X, 3) = Txt3.Text
xlApp.Quit '退出EXCEL
Set xlApp = CreateObject("Excel.Application") '
Set xlBook = xlApp.Workbooks.Open("D:\aa.xls") '
xlApp.Visible = False '
Set xlSheet = xlBook.Worksheets(1) '重新加载EXCEL
X = LblShow.Caption
Do While xlSheet.Cells(X, 1) <> ""
X = X + 1
Loop
LblShow.Caption = X
Txt1.Text = ""
Txt2.Text = ""
Txt3.Text = ""
PicShow = LoadPicture(Txt3.Text)
PicShow.AutoSize = True
End Sub
' 打开图片路径
Private Sub CmdPic_Click()
Form1.Show
End Sub
' 向前翻页
Private Sub CmdPre_Click()
CmdNew.Visible = False
CmdPic.Visible = False
X = LblShow.Caption
X = X - 1
If X > 0 Then
Txt1.Text = xlSheet.Cells(X, 1)
Txt2.Text = xlSheet.Cells(X, 2)
Txt3.Text = xlSheet.Cells(X, 3)
PicShow = LoadPicture(xlSheet.Cells(X, 3))
PicShow.AutoSize = True
LblShow.Caption = X
Else
MsgBox "已经到第一条记录"
End If

End Sub
'退出程序
Private Sub CmdQuit_Click()
xlApp.Quit
Set xlApp = Nothing
End
End Sub
'查看记录
Private Sub CmdShow_Click()
CmdNew.Visible = False
CmdPic.Visible = False
xlApp.Quit
Set xlApp = Nothing
Call Form_Load
End Sub
'查看起始页
Private Sub CmdStart_Click()
CmdNew.Visible = False
CmdPic.Visible = False
X = LblShow.Caption
X = X - 1
If X > 0 Then
xlApp.Quit
Set xlApp = Nothing
Call Form_Load
Else
MsgBox "已经到第一条记录"
End If

End Sub
'向后翻页
Private Sub CmdSuf_Click()
CmdNew.Visible = False
CmdPic.Visible = False
X = LblShow.Caption
X = X + 1
If xlSheet.Cells(X, 1) <> "" Then
Txt1.Text = xlSheet.Cells(X, 1)
Txt2.Text = xlSheet.Cells(X, 2)
Txt3.Text = xlSheet.Cells(X, 3)
PicShow = LoadPicture(xlSheet.Cells(X, 3))
PicShow.AutoSize = True
LblShow.Caption = X
Else
MsgBox "已经到最后一条记录"
End If
End Sub
'加载数据
Private Sub Form_Load()
CmdNew.Visible = False
CmdPic.Visible = False
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("D:\aa.xls")
xlApp.Visible = False
Set xlSheet = xlBook.Worksheets(1)
Txt1.Text = xlSheet.Cells(1, 1)
Txt2.Text = xlSheet.Cells(1, 2)
Txt3.Text = xlSheet.Cells(1, 3)
PicShow = LoadPicture(xlSheet.Cells(1, 3))
PicShow.AutoSize = True
LblShow.Caption = 1
End Sub

在保存新记录时，第一条记录没有问题，第二条记录就出现要求保存为 “副本文件”了，是哪里代码出错了？

[[it] 本帖最后由 kangduty 于 2009-8-4 13:39 编辑 [/it]]

已经放包