Question

code：

Dim sItem As String
Dim backslash As String

Private Sub browse_Button_Click()
Dim fldr As FileDialog
Dim strPath As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then Exit Sub
    sItem = .SelectedItems(1)
End With
showFilePath.Text = sItem
backslash = Right(sItem, 1)
End Sub

Private Sub cancel_button_Click()
Unload Me
End Sub

Private Sub export_button_Click()
If showFilePath = "" Then
    MsgBox "Select a folder"
    Exit Sub
End If
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
If (backslash = Chr(92)) Then
    FolderName = sItem & xWb.Name & " " & DateString
Else
    FolderName = sItem & "\" & xWb.Name & " " & DateString
End If
MkDir FolderName
For Each xWs In xWb.Worksheets
    xWs.Copy
        If xlsx = True Then
            FileExtStr = ".xlsx": FileFormatNum = 51
            Unload Me
        ElseIf xlsm = True Then
            FileExtStr = ".xlsm": FileFormatNum = 52
            Unload Me
        ElseIf xls = True Then
            FileExtStr = ".xls": FileFormatNum = 56
            Unload Me
        ElseIf xlsb = True Then
            FileExtStr = ".xlsb": FileFormatNum = 50
            Unload Me
        ElseIf csv = True Then
            FileExtStr = ".csv": FileFormatNum = 6
            Unload Me
        ElseIf txt = True Then
            FileExtStr = ".txt": FileFormatNum = -4158
            Unload Me
        ElseIf txt_unicode = True Then
            FileExtStr = ".txt": FileFormatNum = 42
            Unload Me
        ElseIf html = True Then
            FileExtStr = ".html": FileFormatNum = 44
            Unload Me
        ElseIf mhtml = True Then
            FileExtStr = ".mhtml": FileFormatNum = 45
            Unload Me
        ElseIf prn = True Then
            FileExtStr = ".prn": FileFormatNum = 36
            Unload Me
        ElseIf dbf3 = True Then
            FileExtStr = ".dbf": FileFormatNum = 8
            Unload Me
        ElseIf dbf4 = True Then
            FileExtStr = ".dbf": FileFormatNum = 11
            Unload Me
        End If
    xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False
Next

MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

用户表单：
{{0}}

此代码在创建为单独的.xlsm文件时有效。但是，当我将其设置为功能区控件时，如下所示，它不起作用。实际上，它将创建3个名为Sheet1, Sheet2 and Sheet3的空工作表。我的工作表命名为Budget, Profit。仅有2张纸，而代码创建了3张纸，名称不同，而且没有记录。

请帮助。

色带控制：
{{0}}

Answer 1

ThisWorkbook代表运行此代码的工作簿。
ActiveWorkbook代表当前处于活动状态（已聚焦）的工作簿。

所以您应该更改

Set xWb = Application.ThisWorkbook

进入

Set xWb = Application.ActiveWorkbook

（如果将其用作插件）。否则，它将尝试访问插件中的工作表，而不是工作簿。

在导出工作表VBA时创建空表

1 个答案: