Warning: file_get_contents(/data/phpspider/zhask/data//catemap/0/vba/15.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
使用VBA将选定图纸保存为HTML_Vba_Excel - Fatal编程技术网

使用VBA将选定图纸保存为HTML

使用VBA将选定图纸保存为HTML,vba,excel,Vba,Excel,我正在使用以下VBA保存特定的图纸。我想保存在HTML的工作表。我试着换衣服。xls to.html,但我得到的只是gobby-gook(技术术语),如有任何帮助,将不胜感激 Option Explicit Sub TwoSheetsAndYourOut() Dim NewName As String Dim nm As Name Dim ws As Worksheet If MsgBox("Copy specific sheets to a new

我正在使用以下VBA保存特定的图纸。我想保存在HTML的工作表。我试着换衣服。xls to.html,但我得到的只是gobby-gook(技术术语),如有任何帮助,将不胜感激

Option Explicit 

Sub TwoSheetsAndYourOut() 
    Dim NewName As String 
    Dim nm As Name 
    Dim ws As Worksheet 

    If MsgBox("Copy specific sheets to a new workbook" & vbCr & _ 
    "New sheets will be pasted as values, named ranges removed" _ 
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub 

    With Application 
        .ScreenUpdating = False 

         '       Copy specific sheets
         '       *SET THE SHEET NAMES TO COPY BELOW*
         '       Array("Sheet Name", "Another sheet name", "And Another"))
         '       Sheet names go inside quotes, separated by commas
        On Error GoTo ErrCatcher 
        Sheets(Array("Copy Me", "Copy Me2")).Copy 
        On Error GoTo 0 

         '       Paste sheets as values
         '       Remove External Links, Hperlinks and hard-code formulas
         '       Make sure A1 is selected on all sheets
        For Each ws In ActiveWorkbook.Worksheets 
            ws.Cells.Copy 
            ws.[A1].PasteSpecial Paste:=xlValues 
            ws.Cells.Hyperlinks.Delete 
            Application.CutCopyMode = False 
            Cells(1, 1).Select 
            ws.Activate 
        Next ws 
        Cells(1, 1).Select 

         '       Remove named ranges
        For Each nm In ActiveWorkbook.Names 
            nm.Delete 
        Next nm 

         '       Input box to name new file
        NewName = InputBox("Please Specify the name of your new workbook", "New Copy") 

         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls" 
        ActiveWorkbook.Close SaveChanges:=False 

        .ScreenUpdating = True 
    End With 
    Exit Sub 

ErrCatcher: 
    MsgBox "Specified sheets do not exist within this workbook" 
End Sub 
使用Ron de Bruin的密码。从
中为每个ws…
循环调用它

我找到了解决方案

ActiveWorkbook.SaveCopyAs thiswoolk.Path&“\”&NewName&“.xls”
ActiveWorkbook.SaveAs文件名:=“C:*locationtosave**.html”,文件格式:=xlHtml