Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 4999|回复: 13

[已解决]保存路径问题

[复制链接]
发表于 2014-6-29 12:41 | 显示全部楼层 |阅读模式
老师们好,我想在

导出功能二   代码中,也像 导出功能一 那样,当没有选择工作表时,点击了导出命令,就弹出没有选择工作表的提示,
在保存时,还是弹出跟功能一那样的保存路径,默认路径是当前路径,可以选择路径保存。

谢谢老师们了!


导出功能问题.rar (16.32 KB, 下载次数: 11)
发表于 2014-6-29 14:43 | 显示全部楼层
Private Sub CommandButton3_Click()    '导出功能二
'将选择的工作表导出生成单独工作薄
    Dim i As Long, strName, s, Mapp, Directory
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                If s < 1 Then
                    Set Mapp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择存放目录:", &H1)
                    If Not Mapp Is Nothing Then
                        Directory = Mapp.self.Path
                        If Not Directory Like "*\" Then Directory = Directory & "\"
                    Else
                      MsgBox "无工作表导出!"
                      Exit Sub
                    End If
                End If
                strName = .List(i)
                Worksheets(.List(i)).Copy
                ActiveWorkbook.SaveAs Filename:=Directory & .List(i), FileFormat:=ThisWorkbook.FileFormat
                MsgBox strName & " 已导出"
                ActiveWorkbook.Close
                s = 1
            End If
        Next
        If s < 1 Then MsgBox " 你没有选择要导出的工作表!": GoTo 10
        MsgBox "导出完成"
    End With
10  Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub
回复

使用道具 举报

 楼主| 发表于 2014-6-29 14:54 | 显示全部楼层
本帖最后由 yjwdjfqb 于 2014-6-29 14:55 编辑
zjdh 发表于 2014-6-29 14:43
Private Sub CommandButton3_Click()    '导出功能二
'将选择的工作表导出生成单独工作薄
    Dim i As L ...

老师你好,你在技巧网帮我回复了,很感谢

加了,没有选择工作表的提示,

保存路径,也帮我改改好吧

保存的默认路径是当前路径,也可以选择路径
回复

使用道具 举报

 楼主| 发表于 2014-6-29 14:58 | 显示全部楼层
zjdh 发表于 2014-6-29 14:43
Private Sub CommandButton3_Click()    '导出功能二
'将选择的工作表导出生成单独工作薄
    Dim i As L ...

路径如下图:
无标题.jpg

像这个样子
回复

使用道具 举报

发表于 2014-6-29 16:00 | 显示全部楼层
本帖最后由 zjdh 于 2014-6-29 16:14 编辑
yjwdjfqb 发表于 2014-6-29 14:58
路径如下图:


怎么可能是这个对话框呢?你是要每个工作表保存一个文件,与功能一不一样!
回复

使用道具 举报

发表于 2014-6-29 16:13 | 显示全部楼层
可以将
Else
    MsgBox "无工作表导出!"
    Exit Sub
End If

改为
Else
   MsgBox "你未选择存放目录,工作表将导出到: " & ThisWorkbook.Path
   Directory = ThisWorkbook.Path & "\"
End If
回复

使用道具 举报

 楼主| 发表于 2014-6-30 09:35 | 显示全部楼层
zjdh 发表于 2014-6-29 16:13
可以将
Else
    MsgBox "无工作表导出!"

Private Sub CommandButton3_Click()    '导出功能二
'将选择的工作表导出生成单独工作薄
    Dim mypath As String
    Dim i As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '动态路径
    With Application.FileDialog(msoFileDialogFolderPicker)    '文件夹对话框
        .Title = "选择路径"    '设置标题
        .InitialFileName = ActiveWorkbook.Path & "\"    '使用FileDialog打开文件对话框的时候,设置其默认默认路径为当前工作薄所在路径
        .Show    '打开文件夹对话框
        If .SelectedItems.Count <> 0 Then mypath = .SelectedItems(1)    '把路径赋值给变量
        If mypath = "" Then Exit Sub    '点击取消按钮退出程序
    End With
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                Worksheets(.List(i)).Copy
                ActiveWorkbook.SaveAs Filename:=mypath & "\" & .List(i), FileFormat:=ThisWorkbook.FileFormat
                ActiveWorkbook.Close True
            End If
        Next
        MsgBox "导出完成"
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub


老师,查了下资料,这样可以设置动态路径
请老师再把那个,没有选择工作表的提示帮我加下,谢谢老师了!
回复

使用道具 举报

发表于 2014-6-30 10:21 | 显示全部楼层    本楼为最佳答案   
Private Sub CommandButton3_Click()       '导出功能二
'将选择的工作表导出生成单独工作薄
    Dim mypath As String
    Dim i As Long, S%
    For i = 0 To Me.ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then S = S + 1
    Next
    If S < 1 Then MsgBox "你没有选择工作表!": Exit Sub
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ..................
End Sub

评分

参与人数 1 +9 收起 理由
yjwdjfqb + 9 很给力!感谢老师耐心解答!

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2014-6-30 16:10 | 显示全部楼层
本帖最后由 yjwdjfqb 于 2014-6-30 16:11 编辑
zjdh 发表于 2014-6-30 10:21
Private Sub CommandButton3_Click()       '导出功能二
'将选择的工作表导出生成单独工作薄
    Dim myp ...

     
测试.rar (13.6 KB, 下载次数: 5)
回复

使用道具 举报

发表于 2014-6-30 17:04 | 显示全部楼层
yjwdjfqb 发表于 2014-6-30 16:10
我把这个导出功能,做成加载宏工具,在使用时,导出的路径成了  加载宏文件 所在的路径,我作 ...

提取扩展名语句应该加在
Worksheets(Split(strSheet, "︱")).Copy 之前!

kzm = Mid(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, "."))
Select Case j
Case j > 1
Worksheets(Split(strSheet, "︱")).Copy
strName = ThisWorkbook.Path & "\" & myName & "_" & "导出数据" & kzm
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 14:20 , Processed in 1.114838 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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