设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 大家帮忙改个句子
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 3821|回复: 11

[已解决]大家帮忙改个句子

[复制链接]
发表于 2013-6-19 10:41 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
     Private Sub Command2_Click()
  Dim Ff%
  Dim strFnm$
  Dim n&, col%
  Dim strtmp As String
  strFnm = App.Path & "\导出.txt"
  Ff = FreeFile
  With Adodc1.Recordset
  n = .RecordCount
  col = .Fields.Count
  If n > 0 Then
  Open strFnm For Output As #Ff
.MoveFirst
  Do While Not .EOF
  strtmp = ""
  For j = 0 To col - 1
  strtmp = strtmp & IIf(strtmp = "", "", vbTab) & .Fields(j)
  Next j
  Print #Ff, strtmp
  .MoveNext
  Loop
  Close #Ff
  MsgBox "导出完成!文件位置:" & vbCrLf & App.Path & "\导出.txt"
  End If
  End With
  End Sub
把这段改成将  导出的.txt文件选择保存路径
最佳答案
月排行榜 / 总排行榜
那么的帅
2013-6-20 09:15
qihaizhong2013 发表于 2013-6-20 08:19
大家费心在给研究一下！谢谢了

第一步：新建一个Modules，假设为Modulas3.bas
把下面的复制到Module.bas中

  1. Public Const BIF_RETURNONLYFSDIRS = 1
  2. Public Const BIF_DONTGOBELOWDOMAIN = 2
  3. Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (LpBrowseInfo As BROWSEINFO) As Long
  4. Public Declare Function SHGetPathFromIDlist Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  5. Public Type BROWSEINFO
  6. hOwner As Long
  7. pidlroot As Long
  8. pszDisplayName As String
  9. lpszTitle As String
  10. ulFlags As Long
  11. lpfn As Long
  12. lparam As Long
  13. iImage As Long
  14. End Type
  15. Public Function GetFolder(ByVal hWnd As Long, Optional Title As String) As String
  16.     Dim bi As BROWSEINFO
  17.     Dim pidl As Long
  18.     Dim folder As String
  19.     folder = Space(255)
  20. With bi
  21.    If IsNumeric(hWnd) Then .hOwner = hWnd
  22.    .ulFlags = BIF_RETURNONLYFSDIRS
  23.    .pidlroot = 0
  24.    If Title <> "" Then
  25.       .lpszTitle = Title & Chr$(0)
  26.    Else
  27.       .lpszTitle = "选择目录" & Chr$(0)
  28.     End If
  29. End With[/p][p=null, 2, left]pidl = SHBrowseForFolder(bi)
  30. If SHGetPathFromIDlist(ByVal pidl, ByVal folder) Then
  31.     GetFolder = Left(folder, InStr(folder, Chr$(0)) - 1)
  32. Else
  33.     GetFolder = ""
  34. End If
  35. End Function
复制代码
第二步 ,修改代码

Private Sub Command2_Click()
  Dim Ff%
  Dim strFnm$
  Dim n&, col%
  Dim strtmp As String
Dim str
    str = GetFolder(Me.hWnd, "浏览文件夹")  '取得选取路径

  strFnm = str & "\导出.txt"
  Ff = FreeFile
  With Adodc1.Recordset
  n = .RecordCount
  col = .Fields.Count
  If n > 0 Then
  Open strFnm For Output As #Ff
.MoveFirst
  Do While Not .EOF
  strtmp = ""
  For j = 0 To col - 1
  strtmp = strtmp & IIf(strtmp = "", "", vbTab) & .Fields(j)
  Next j
  Print #Ff, strtmp
  .MoveNext
  Loop
  Close #Ff
  MsgBox "导出完成!文件位置:" & vbCrLf & str & "\导出.txt"
  End If
  End With
  End Sub

excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
yagi
发表于 2013-6-19 10:46 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
本帖最后由 yagi 于 2013-6-19 10:50 编辑

加一句：
  1. Application.GetSaveAsFilename
复制代码
回复

使用道具 举报

 楼主| 发表于 2013-6-19 11:49 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
不行呀！选择无效！
回复

使用道具 举报

 楼主| 发表于 2013-6-19 13:03 | 显示全部楼层
还有没有更好的！
回复

使用道具 举报

发表于 2013-6-19 16:17 | 显示全部楼层
  1. Application.Dialogs(5).Show
复制代码
回复

使用道具 举报

 楼主| 发表于 2013-6-19 16:27 | 显示全部楼层
还是不行，见附件

入库信息管理系统.rar

314.88 KB, 下载次数: 8
回复

使用道具 举报

发表于 2013-6-19 16:36 | 显示全部楼层
qihaizhong2013 发表于 2013-6-19 13:03
还有没有更好的！
  1. Private Sub Command2_Click()
  2.     Dim Ff%
  3.     Dim strFnm$
  4.     Dim n&, col%
  5.     Dim strtmp As String
  6.     With Application.FileDialog(msoFileDialogFolderPicker)
  7.         If .Show = -1 Then
  8.             Fila_name = .SelectedItems(1)
  9.         Else
  10.             Exit Sub
  11.         End If
  12.     End With
  13.     strFnm = Fila_name & "\导出.txt"
  14.     Ff = FreeFile
  15.     With Adodc1.Recordset
  16.         n = .RecordCount
  17.         col = .Fields.Count
  18.         If n > 0 Then
  19.             Open strFnm For Output As #Ff
  20.             .MoveFirst
  21.             Do While Not .EOF
  22.                 strtmp = ""
  23.                 For j = 0 To col - 1
  24.                     strtmp = strtmp & IIf(strtmp = "", "", vbTab) & .Fields(j)
  25.                 Next j
  26.                 Print #Ff, strtmp
  27.                 .MoveNext
  28.             Loop
  29.             Close #Ff
  30.             MsgBox "导出完成!文件位置:" & vbCrLf & Fila_name & "\导出.txt"
  31.         End If
  32.     End With
  33. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2013-6-20 08:16 | 显示全部楼层
怎么还是报错“对象 FileDialog的方法 _Application失败”
回复

使用道具 举报

 楼主| 发表于 2013-6-20 08:19 | 显示全部楼层
大家费心在给研究一下！谢谢了
回复

使用道具 举报

发表于 2013-6-20 09:15 | 显示全部楼层    本楼为最佳答案   
qihaizhong2013 发表于 2013-6-20 08:19
大家费心在给研究一下！谢谢了

第一步：新建一个Modules，假设为Modulas3.bas
把下面的复制到Module.bas中

  1. Public Const BIF_RETURNONLYFSDIRS = 1
  2. Public Const BIF_DONTGOBELOWDOMAIN = 2
  3. Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (LpBrowseInfo As BROWSEINFO) As Long
  4. Public Declare Function SHGetPathFromIDlist Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  5. Public Type BROWSEINFO
  6. hOwner As Long
  7. pidlroot As Long
  8. pszDisplayName As String
  9. lpszTitle As String
  10. ulFlags As Long
  11. lpfn As Long
  12. lparam As Long
  13. iImage As Long
  14. End Type
  15. Public Function GetFolder(ByVal hWnd As Long, Optional Title As String) As String
  16.     Dim bi As BROWSEINFO
  17.     Dim pidl As Long
  18.     Dim folder As String
  19.     folder = Space(255)
  20. With bi
  21.    If IsNumeric(hWnd) Then .hOwner = hWnd
  22.    .ulFlags = BIF_RETURNONLYFSDIRS
  23.    .pidlroot = 0
  24.    If Title <> "" Then
  25.       .lpszTitle = Title & Chr$(0)
  26.    Else
  27.       .lpszTitle = "选择目录" & Chr$(0)
  28.     End If
  29. End With[/p][p=null, 2, left]pidl = SHBrowseForFolder(bi)
  30. If SHGetPathFromIDlist(ByVal pidl, ByVal folder) Then
  31.     GetFolder = Left(folder, InStr(folder, Chr$(0)) - 1)
  32. Else
  33.     GetFolder = ""
  34. End If
  35. End Function
复制代码
第二步 ,修改代码

Private Sub Command2_Click()
  Dim Ff%
  Dim strFnm$
  Dim n&, col%
  Dim strtmp As String
Dim str
    str = GetFolder(Me.hWnd, "浏览文件夹")  '取得选取路径

  strFnm = str & "\导出.txt"
  Ff = FreeFile
  With Adodc1.Recordset
  n = .RecordCount
  col = .Fields.Count
  If n > 0 Then
  Open strFnm For Output As #Ff
.MoveFirst
  Do While Not .EOF
  strtmp = ""
  For j = 0 To col - 1
  strtmp = strtmp & IIf(strtmp = "", "", vbTab) & .Fields(j)
  Next j
  Print #Ff, strtmp
  .MoveNext
  Loop
  Close #Ff
  MsgBox "导出完成!文件位置:" & vbCrLf & str & "\导出.txt"
  End If
  End With
  End Sub

回复

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-28 04:24 , Processed in 0.471408 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表