想实现功能:
1、另存为一个.csv后缀名的文件,并且保存在固定目录下。
2、判断这个文件是否存在,并且提示。程序如下 如何修改呢?Public sfind As String '定义全局变量,便于查找命令的实现
Dim edit As Boolean
Dim SaveFileName As StringPrivate Sub Form_Load()
RichTextBox1.Text = "" '窗体加载编辑框内容为空
CommonDialog1.Filter = "DAT File *.dat| *.dat|Excel File *.csv| *.csv" 'Filter files, *.dat,*.csv only
StatusBar1.Panels(5).Text = "TYPE:" & CommonDialog1.Filter
Timer1.Interval = 1
munnew.Enabled = False
munfound.Enabled = False
munfindnext.Enabled = False
munlingc.Enabled = False
munjianq.Enabled = False
muncopy.Enabled = False
mundelete.Enabled = False
munxall.Enabled = False
If Clipboard.GetText() = "" Then
numzhant.Enabled = False
Else
numzhant.Enabled = True
End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim i As String
If edit Then
i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
If i = vbYes Then
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName, 1 '//这里是保存文件其中1表示保存为TXT
End If
End If
End SubPrivate Sub mun_Click() '保存
Dim inputdata As String
If SaveFileName <> "" Then
Open SaveFileName For Output As #1 Print #1, RichTextBox1.Text
Close #1 Else
CommonDialog1.CancelError = True '出错解决方法
On Error GoTo ErrHandler '出错解决方法
CommonDialog1.ShowSave '调出保存对话框
FileType = CommonDialog1.FileTitle
FiType = LCase(Right(FileType, 3))
FileName = CommonDialog1.FileName
Select Case FiType
Case "dat"
Case "csv"
RichTextBox1.SaveFile FileName, rtfText
End Select
ErrHandler:
End If
End SubPrivate Sub munabout_Click()
MsgBox "NanoSpec 3000 Data Reader CopyRight: Ambrosia Chan @ Littel Fuse 2011", , "NanoSpec Data Reader" '对话框
End Sub
Private Sub muncolor_Click() '颜色
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler '报错处理
CommonDialog1.ShowColor ' 调出颜色对话框
RichTextBox1.BackColor = CommonDialog1.Color '背景颜色设置
ErrHandler:
End Sub
Private Sub muncopy_Click()
Clipboard.Clear '清空剪切板
Clipboard.SetText RichTextBox1.SelText '复制选中的内容
End SubPrivate Sub mundelete_Click()
RichTextBox1.SelText = "" '清空RichTextBox1选中的内容!
End SubPrivate Sub munexit_Click() '退出
Dim i As String
If edit Then
i = MsgBox("File Changed save or not?", vbYesNoCancel + vbInformation, "Notice")
If i = vbYes Then
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName, 1 '这里是保存文件其中1表示保存为TXT
End
ElseIf i = vbCancel Then
Exit Sub
ElseIf i = vbNo Then
End
Else
End
End If
End If
If edit = False Then
End
End IfEnd SubPrivate Sub munfindnext_Click() '查找下一个
RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength + 1 '继续查找下一个内容
RichTextBox1.Find sfind, , Len(RichTextBox1)
End SubPrivate Sub munfont_Click() '设置字体
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler '报错处理
CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects '设置字体对话框的样式
CommonDialog1.ShowFont
If CommonDialog1.FontName > "" Then
Form1.RichTextBox1.Font = CommonDialog1.FontName
End If
RichTextBox1.SelFontSize = CommonDialog1.FontSize
RichTextBox1.SelBold = CommonDialog1.FontBold
RichTextBox1.SelItalic = CommonDialog1.FontItalic
RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
RichTextBox1.SelColor = CommonDialog1.Color
ErrHandler:
End SubPrivate Sub munfontcolor_Click()
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler
CommonDialog1.ShowColor '调出颜色对话框
RichTextBox1.SelColor = CommonDialog1.Color '设置字体颜色
ErrHandler: '结束报错
End SubPrivate Sub munfound_Click()
sfind = InputBox("Please input the keywords", "Find", sfind) '查找输入框
RichTextBox1.Find sfind '查找
End SubPrivate Sub munhelpzhut_Click()
frmtest.Show '调出窗体form2
End Sub
Private Sub munjianq_Click()
Clipboard.Clear '清空剪切板内容
Clipboard.SetText RichTextBox1.SelText ' 剪切选择内容
RichTextBox1.SelText = ""
End SubPrivate Sub munlingc_Click() '另存为对话框
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As #1
Print #1, RichTextBox1.Text
Close #1
ErrHandler:
End SubPrivate Sub munnew_Click()
Dim i As String
If edit Then
i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
If i = vbYes Then
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName, 1 '//这里是保存文件其中1表示保存为TXT
ErrHandler:
End If
End If
RichTextBox1.Text = ""
End Sub
Private Sub munopen_Click() '打开对话框
Dim i As String
If RichTextBox1.Text <> "" Then
i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
If i = vbYes Then
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName, rtfText '//这里是保存文件其中1表示保存为TXT
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler
CommonDialog1.ShowOpen '打开对话框
RichTextBox1.Text = "" '清空文本框
FileName = CommonDialog1.FileName '文件路径
RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
ErrHandler:
Else
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler
CommonDialog1.ShowOpen
RichTextBox1.Text = "" '清空文本框
FileName = CommonDialog1.FileName '文件路径
RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
End IfElse
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler
CommonDialog1.ShowOpen
RichTextBox1.Text = "" '清空文本框
FileName = CommonDialog1.FileName '文件路径
RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
End If
End SubPrivate Sub munprint_Click()
CommonDialog1.ShowPrinter '打印
End SubPrivate Sub munxall_Click() '全选
RichTextBox1.SelStart = 0
RichTextBox1.SelLength = Len(RichTextBox1.Text)
End Sub
Private Sub numzhant_Click()
RichTextBox1.SelText = Clipboard.GetText '粘贴
End Sub
Private Sub RichTextBox1_Change()
If RichTextBox1.Text = "" Then
munnew.Enabled = False
mun.Enabled = False
munfound.Enabled = False
munfindnext.Enabled = False
munlingc.Enabled = False
munjianq.Enabled = False
muncopy.Enabled = False
mundelete.Enabled = False
munxall.Enabled = False
Else
munnew.Enabled = True
mun.Enabled = True
munfound.Enabled = True
munfindnext.Enabled = True
munlingc.Enabled = True
numzhant.Enabled = True
mundelete.Enabled = True
munxall.Enabled = True
munjianq.Enabled = True
muncopy.Enabled = True
End If
End SubPrivate Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)End SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) '工具栏的设置
Dim id
Select Case Button.Index
Case 1 '打开
Call munopen_Click
Case 2 '新建
Call munnew_Click
Case 3 '复制
Call muncopy_Click
Case 4 ' 保存
Call mun_Click
Case 5 '剪切
Call munjianq_Click
Case 6 '粘贴
Call numzhant_Click
Case 7 'Shell的调用,调出系统自带计算器
id = Shell("C:\WINDOWS\system32\calc.exe", 1)
Case 8 'Shell的调用,调出系统自带浏览器并打开指定网址
id = Shell("C:\Program Files\Internet Explorer\IEXPLORE.EXE http://wuxiweb/", 1)
Case 9 'Shell的调用,调出系统自带CMD.exe
id = Shell("C:\WINDOWS\system32\cmd.exe", 1)
End Select
End Sub
'设置编辑框的位置和大小
Private Sub Form_Resize()
On Error Resume Next '出错处理
RichTextBox1.Top = 600 '编辑框头部距上边框的距离
RichTextBox1.Left = 50 '编辑框距左边窗体的距离
RichTextBox1.Height = ScaleHeight - 1000 '编辑框距底部的距离
RichTextBox1.Width = ScaleWidth - 100 '编辑框距宽度等于窗体的宽度-100
End Sub
Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) ' 鼠标右键快捷键
If Button = 2 Then ' 单击左键时返回值为1,单击右键返回值为2!如果是2则是右键,调出菜单
PopupMenu munedit ' 弹出菜单的设置项
End If
edit = True
End Sub
Private Sub Timer1_Timer()
Me.StatusBar1.Panels(2) = "Date:" & Now() ' 状态栏第二个窗格显示系统时间
End Sub
1、另存为一个.csv后缀名的文件,并且保存在固定目录下。
2、判断这个文件是否存在,并且提示。程序如下 如何修改呢?Public sfind As String '定义全局变量,便于查找命令的实现
Dim edit As Boolean
Dim SaveFileName As StringPrivate Sub Form_Load()
RichTextBox1.Text = "" '窗体加载编辑框内容为空
CommonDialog1.Filter = "DAT File *.dat| *.dat|Excel File *.csv| *.csv" 'Filter files, *.dat,*.csv only
StatusBar1.Panels(5).Text = "TYPE:" & CommonDialog1.Filter
Timer1.Interval = 1
munnew.Enabled = False
munfound.Enabled = False
munfindnext.Enabled = False
munlingc.Enabled = False
munjianq.Enabled = False
muncopy.Enabled = False
mundelete.Enabled = False
munxall.Enabled = False
If Clipboard.GetText() = "" Then
numzhant.Enabled = False
Else
numzhant.Enabled = True
End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
Dim i As String
If edit Then
i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
If i = vbYes Then
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName, 1 '//这里是保存文件其中1表示保存为TXT
End If
End If
End SubPrivate Sub mun_Click() '保存
Dim inputdata As String
If SaveFileName <> "" Then
Open SaveFileName For Output As #1 Print #1, RichTextBox1.Text
Close #1 Else
CommonDialog1.CancelError = True '出错解决方法
On Error GoTo ErrHandler '出错解决方法
CommonDialog1.ShowSave '调出保存对话框
FileType = CommonDialog1.FileTitle
FiType = LCase(Right(FileType, 3))
FileName = CommonDialog1.FileName
Select Case FiType
Case "dat"
Case "csv"
RichTextBox1.SaveFile FileName, rtfText
End Select
ErrHandler:
End If
End SubPrivate Sub munabout_Click()
MsgBox "NanoSpec 3000 Data Reader CopyRight: Ambrosia Chan @ Littel Fuse 2011", , "NanoSpec Data Reader" '对话框
End Sub
Private Sub muncolor_Click() '颜色
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler '报错处理
CommonDialog1.ShowColor ' 调出颜色对话框
RichTextBox1.BackColor = CommonDialog1.Color '背景颜色设置
ErrHandler:
End Sub
Private Sub muncopy_Click()
Clipboard.Clear '清空剪切板
Clipboard.SetText RichTextBox1.SelText '复制选中的内容
End SubPrivate Sub mundelete_Click()
RichTextBox1.SelText = "" '清空RichTextBox1选中的内容!
End SubPrivate Sub munexit_Click() '退出
Dim i As String
If edit Then
i = MsgBox("File Changed save or not?", vbYesNoCancel + vbInformation, "Notice")
If i = vbYes Then
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName, 1 '这里是保存文件其中1表示保存为TXT
End
ElseIf i = vbCancel Then
Exit Sub
ElseIf i = vbNo Then
End
Else
End
End If
End If
If edit = False Then
End
End IfEnd SubPrivate Sub munfindnext_Click() '查找下一个
RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength + 1 '继续查找下一个内容
RichTextBox1.Find sfind, , Len(RichTextBox1)
End SubPrivate Sub munfont_Click() '设置字体
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler '报错处理
CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects '设置字体对话框的样式
CommonDialog1.ShowFont
If CommonDialog1.FontName > "" Then
Form1.RichTextBox1.Font = CommonDialog1.FontName
End If
RichTextBox1.SelFontSize = CommonDialog1.FontSize
RichTextBox1.SelBold = CommonDialog1.FontBold
RichTextBox1.SelItalic = CommonDialog1.FontItalic
RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
RichTextBox1.SelUnderline = CommonDialog1.FontUnderline
RichTextBox1.SelColor = CommonDialog1.Color
ErrHandler:
End SubPrivate Sub munfontcolor_Click()
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler
CommonDialog1.ShowColor '调出颜色对话框
RichTextBox1.SelColor = CommonDialog1.Color '设置字体颜色
ErrHandler: '结束报错
End SubPrivate Sub munfound_Click()
sfind = InputBox("Please input the keywords", "Find", sfind) '查找输入框
RichTextBox1.Find sfind '查找
End SubPrivate Sub munhelpzhut_Click()
frmtest.Show '调出窗体form2
End Sub
Private Sub munjianq_Click()
Clipboard.Clear '清空剪切板内容
Clipboard.SetText RichTextBox1.SelText ' 剪切选择内容
RichTextBox1.SelText = ""
End SubPrivate Sub munlingc_Click() '另存为对话框
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Output As #1
Print #1, RichTextBox1.Text
Close #1
ErrHandler:
End SubPrivate Sub munnew_Click()
Dim i As String
If edit Then
i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
If i = vbYes Then
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName, 1 '//这里是保存文件其中1表示保存为TXT
ErrHandler:
End If
End If
RichTextBox1.Text = ""
End Sub
Private Sub munopen_Click() '打开对话框
Dim i As String
If RichTextBox1.Text <> "" Then
i = MsgBox("File Changed save or not?", vbYesNo + vbInformation, "Notice")
If i = vbYes Then
CommonDialog1.CancelError = True
On Error GoTo ErrHandler
CommonDialog1.ShowSave
RichTextBox1.SaveFile CommonDialog1.FileName, rtfText '//这里是保存文件其中1表示保存为TXT
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler
CommonDialog1.ShowOpen '打开对话框
RichTextBox1.Text = "" '清空文本框
FileName = CommonDialog1.FileName '文件路径
RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
ErrHandler:
Else
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler
CommonDialog1.ShowOpen
RichTextBox1.Text = "" '清空文本框
FileName = CommonDialog1.FileName '文件路径
RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
End IfElse
CommonDialog1.CancelError = True '报错处理
On Error GoTo ErrHandler
CommonDialog1.ShowOpen
RichTextBox1.Text = "" '清空文本框
FileName = CommonDialog1.FileName '文件路径
RichTextBox1.LoadFile FileNameSaveFileName = CommonDialog1.FileName
End If
End SubPrivate Sub munprint_Click()
CommonDialog1.ShowPrinter '打印
End SubPrivate Sub munxall_Click() '全选
RichTextBox1.SelStart = 0
RichTextBox1.SelLength = Len(RichTextBox1.Text)
End Sub
Private Sub numzhant_Click()
RichTextBox1.SelText = Clipboard.GetText '粘贴
End Sub
Private Sub RichTextBox1_Change()
If RichTextBox1.Text = "" Then
munnew.Enabled = False
mun.Enabled = False
munfound.Enabled = False
munfindnext.Enabled = False
munlingc.Enabled = False
munjianq.Enabled = False
muncopy.Enabled = False
mundelete.Enabled = False
munxall.Enabled = False
Else
munnew.Enabled = True
mun.Enabled = True
munfound.Enabled = True
munfindnext.Enabled = True
munlingc.Enabled = True
numzhant.Enabled = True
mundelete.Enabled = True
munxall.Enabled = True
munjianq.Enabled = True
muncopy.Enabled = True
End If
End SubPrivate Sub StatusBar1_PanelClick(ByVal Panel As MSComctlLib.Panel)End SubPrivate Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button) '工具栏的设置
Dim id
Select Case Button.Index
Case 1 '打开
Call munopen_Click
Case 2 '新建
Call munnew_Click
Case 3 '复制
Call muncopy_Click
Case 4 ' 保存
Call mun_Click
Case 5 '剪切
Call munjianq_Click
Case 6 '粘贴
Call numzhant_Click
Case 7 'Shell的调用,调出系统自带计算器
id = Shell("C:\WINDOWS\system32\calc.exe", 1)
Case 8 'Shell的调用,调出系统自带浏览器并打开指定网址
id = Shell("C:\Program Files\Internet Explorer\IEXPLORE.EXE http://wuxiweb/", 1)
Case 9 'Shell的调用,调出系统自带CMD.exe
id = Shell("C:\WINDOWS\system32\cmd.exe", 1)
End Select
End Sub
'设置编辑框的位置和大小
Private Sub Form_Resize()
On Error Resume Next '出错处理
RichTextBox1.Top = 600 '编辑框头部距上边框的距离
RichTextBox1.Left = 50 '编辑框距左边窗体的距离
RichTextBox1.Height = ScaleHeight - 1000 '编辑框距底部的距离
RichTextBox1.Width = ScaleWidth - 100 '编辑框距宽度等于窗体的宽度-100
End Sub
Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) ' 鼠标右键快捷键
If Button = 2 Then ' 单击左键时返回值为1,单击右键返回值为2!如果是2则是右键,调出菜单
PopupMenu munedit ' 弹出菜单的设置项
End If
edit = True
End Sub
Private Sub Timer1_Timer()
Me.StatusBar1.Panels(2) = "Date:" & Now() ' 状态栏第二个窗格显示系统时间
End Sub
2.if dir("d:\temp\temp.csv")="" then
msgbox "文件已在在"
end if