我是VBA的新手,我有一个任务应在Excel工作表中保存1个.txt格式的特定行。
目前,我只知道如何按特定方向保存它(例如,桌面)。
但是,用户是否可以选择弹出窗口(如另存为)选择自己想保存的位置?
Private Sub CommandButton2_Click()
Dim fso As Object
strPath = "C:\Users\" & Environ("UserName") & "\Desktop\"
strFolderName = "Atskaites"
strFullPath = strPath & strFolderName & "\"
If Dir(strPath & strFolderName, vbDirectory) = "" Then
MkDir strFullPath
End If
Set fso = CreateObject("Scripting.FileSystemObject") 'teksta faila izveidosana
Dim Fileout As Object
Set Fileout = fso.CreateTextFile(strFullPath & TextBox1.Text & ".txt", True, True) 'kur izveidot un kada formata Fileout.Visible = True
Fileout.WriteLine "Klients:"
Fileout.WriteLine (TextBox1.Text)
Fileout.WriteLine "06.17"
Fileout.WriteLine (TextBox2.Text)
Fileout.WriteLine "07.17"
Fileout.WriteLine (TextBox3.Text)
Fileout.WriteLine "08.17"
Fileout.WriteLine (TextBox4.Text)
Fileout.WriteLine "09.17"
Fileout.WriteLine (TextBox5.Text)
Fileout.WriteLine "10.17"
Fileout.WriteLine (TextBox6.Text)
Fileout.WriteLine "Kopa"
Fileout.WriteLine (TextBox7.Text)
MsgBox ("Saved")
Fileout.Close
End Sub
有很多方法可以做到这一点。下面的示例代码只是一种方法。由于您说要保存一行数据,因此它首先要求您选择该行,然后询问要保存在哪个目录中,然后将该行复制到新工作簿中,最后将该工作簿另存为该目录中的文本文件。
当然,您需要针对特定情况对其进行修改。这仅仅是为了让您从可行的事情开始。
Option Explicit
Sub saveRow()
Dim theDir As String
Dim sh As Worksheet, wk As Workbook, r As Range
Set r = Application.InputBox("select the row to export", , , Type:=8)
theDir = folderFromUser("C:/") 'C: is just the default location
Set wk = Workbooks.Add
r.Worksheet.Rows(r.row).Copy
ActiveSheet.Paste
wk.SaveAs theDir & "\test.txt", XlFileFormat.xlUnicodeText
Application.DisplayAlerts = False
wk.Close False
Application.DisplayAlerts = True
End Sub
Function folderFromUser(initialPath As String) As String
Dim fd As FileDialog, ButtonClickedByUser As Boolean, msg As String
On Error GoTo ErrorHandler
Set fd = Application.FileDialog(msoFileDialogFolderPicker) 'see also msoFileDialogFilePicker
fd.AllowMultiSelect = False
fd.InitialFileName = Left(initialPath, InStrRev(initialPath, "\"))
ButtonClickedByUser = fd.Show
If ButtonClickedByUser = False Then Exit Function
folderFromUser = fd.SelectedItems(1)
Exit Function
ErrorHandler:
MsgBox "Error # " & Str(Err.Number) & " was generated by " & Err.Source & Chr(13) _
& Err.Description, , "Error in folderFromUser routine", Err.HelpFile, Err.HelpContext
Err.Clear
End Function
本文收集自互联网,转载请注明来源。
如有侵权,请联系 [email protected] 删除。
我来说两句