I want to save complex Excel file to html format. It can be easily done with Save As dialog, but it generates htm file and folder with same name + .files, where is filelist.xml, sheet001.htm, sheet002.htm, ...
How can I save only first sheet to htm format? So all the information lies in single htm file?(Like MS Word do)
Delete the other sheets before exporting.
(right click on the sheet tab and click delete)
When saving change the selection to web page and select the selection:sheet button press publish and continue as appropriate.
What you can do is copy the sheets you want to save as HTML to a new workbook and save that new workbook as HTML instead. For example:
Public Sub doIt()
hardCopyToNewBook
saveFile "C:\temp\fileName.html"
End Sub
Private Sub hardCopyToNewBook()
Dim tabs As Variant
Dim s As Worksheet
tabs = Array("Sheet1", "Sheet2")
Sheets(tabs).Copy
For Each s In ActiveWorkbook.Sheets
With s
.Cells.Copy
.Cells.PasteSpecial Paste:=xlPasteValues
End With
Next s
Application.CutCopyMode = False
End Sub
Private Sub saveFile(htmlFileName As String)
Application.DisplayAlerts = False
Application.DefaultWebOptions.SaveHiddenData = False
On Error Resume Next
Call ActiveWorkbook.SaveAs(fileName:=htmlFileName, FileFormat:=xlHtml)
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
Found Solution - there is radio button to save only selected sheets
Related
I want to display PDF files for each separate record on my form in Access. The form is populated from a combo box's result (select a key field from combo box), and form gets populated with a large amount of info from a query.
For each unique value in the underlying table, there is a pdf file related to it. I want to use the web browser control to define the file path for each unique key. For example,
S:\FolderPath\xyz\keyvalue.pdf"
where keyvalue.pdf is literally the contents of a text box on the form that has the text field source for that record followed by a '.pdf' so if my key is 1, it will be 1.pdf, if it is A-22ds, the file will be A-22ds.pdf.
Let's say you have a form with a web browser control called MyWebbrowserControl, and you want to get the PDF in there:
Public Sub LoadPDF(MyPdfLocation As String)
Dim wb As Object
Dim strHTML As String
strHTML = "<html><head><title>My PDF</title></head><body>" & _
"<embed style=""width:100%;height:100%;"" src=""" & Application.HtmlEncode(MyPdfLocation) & """ type=""application/pdf""></embed></body></html>"
Set wb = MyWebbrowserControl.Object
With wb
.Navigate2 "about:blank"
Do Until .ReadyState = 4 '=READYSTATE_COMPLETE
'This is an inefficient way to wait, but loading a blank page should only take a couple of milliseconds
DoEvents
Loop
.Document.Open
.Document.Write strHTML
.Document.Close
End With
End Sub
(I'm using very generic HTML, it might benefit from some tweaking).
Them call it on Form_Current, for example:
Private Sub Form_Current()
Dim path As String
Dim filename As String
path = "S:\MDM\MIRS\SCOPE-MP\"
filename = Me.cboPSENumber.Value + "_MP.pdf" 'Final path should be path + filename
Me.LoadPDF path & filename
End Sub
Private Sub bBrowse_Click()
Const msoFileDialogFilePicker As Long = 3
Dim objDialog As Object
Set objDialog = Application.FileDialog(msoFileDialogFilePicker)
With objDialog
.AllowMultiSelect = True
.Show
If .SelectedItems.Count = 0 Then
MsgBox "No file selected."
Else
Me.[File Link].Value = Dir(.SelectedItems(1))
End If
End With
End Sub
I was able to get it to add in the cell I need it to but it when it is clicked it will not open the file or path
Please read this: Debugging VBA Code
to learn how to step through code and inspect variables.
.SelectedItems(1) already contains the full path, but Dir(.SelectedItems(1)) returns only the file name. So remove the Dir().
Now to actually open the file from a record, you need additional code e.g. in a button next to the File Link textbox, or in its DblClick event.
See here: Open Hyperlinks in Access
First post on this forum and I'm new to VBA so I will be as detailed as I can.
I've made a macro that modifies dxf drawing templates inside an excel tab and then writes that data to a new dxf file. I'm currently writing the text file with the code below:
Dim Application2 As Variant
Range("A:A").Copy
Application2 = Shell("c:\windows\notepad.exe", vbMaximizedFocus)
AppActivate Application2
SendKeys "^(V)", True
SendKeys "%fa", True
SendKeys "%t", True
SendKeys "{DOWN 2}", True
SendKeys "%n", True
SendKeys savetarget, True
SendKeys "%s", True
SendKeys "%fx", True
I've been trying to change to the method below so I don't need to open notepad and put in keystrokes.
FN = FreeFile
Open savetarget For Output Shared As #FN
For iCntr = 1 To copy_endline
mystring = workspace.Range("A" & iCntr).Value
Print #FN, mystring
mystring = ""
Next iCntr
Close #FN
This worked sometimes but it seems to modify the formatting somehow so the drawing becomes not readable to Autocad. If I manually copy the data from Row A and paste it into a notepad document it works fine.
I was able to fix my issue by using code from this post:
How to save particular column data of an excel worksheet to .txt file including line breaks in each cell content
I would thank them but I don't have enough reputation. haha
This while write a dxf file from data in one column in excel.
Mine looks something like this:
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile(SaveLocation & DWG_Name & ".dxf", True)
nLastrow = Cells(Rows.Count, "A").End(xlUp).Row
nFirstRow = 1
For N = nFirstRow To nLastrow
t = Cells(N, "A").Text
a.WriteLine (t)
Next
a.Close
This question is very similar to the previously posted question: Save each sheet in a workbook to separate CSV files
However, my requirements are slightly different in that I need to have the ability to ignore specifically named worksheets (see #2 below).
I have been successful in utilizing the solution posted in this answer: https://stackoverflow.com/a/845345/1289884 which was posted in response to the question above meets almost all of my requirements with the exception of #2 below and #3 below:
I have an excel 2010 workbook that consists of multiple worksheets and I am looking for a macro that will:
Save each worksheet to a separate comma delimited CSV file.
Ignore specific named worksheet(s) (i.e. a sheet named TOC and sheet name Lookup)
Save files to a specified folder (example: c:\csv)
Ideal Solution would additionally:
Create a zip file consisting of all of the CSV worksheets within a specified folder
Any help would be greatly appreciated.
Nick,
Given you expanded on your question with the differences, and the zip part is a significant addon I have outlined a solution below that:
Creates the CSV file, skipping specific sheets using this line Case "TOC", "Lookup"
Adds them to a Zip file. This section draws heavily on Ron de Bruin's code here
The code will create the paths under StrMain and StrZipped if they do not already exists
As the ActiveWorkbook gets sub-divided into CSV files the code tests that the ActiveWorkbook is saved prior to proceeding
On (2) I ran across an issue I have seen before in my Produce an Excel list of the attributes of all MP3 files that sit in or below the "My Music" folde where the Shell.Application errored when string variables were passed to it. So I gritted my teeth and added a hardcoding of the earlier paths for Zip_All_Files_in_Folder. I commented out my earlier variable passing to show where I tried this
VBA to save CSVS
Public Sub SaveWorksheetsAsCsv()
Dim ws As Worksheet
Dim strMain As String
Dim strZipped As String
Dim strZipFile As String
Dim lngCalc As Long
strMain = "C:\csv\"
strZipped = "C:\zipcsv\"
strZipFile = "MyZip.zip"
If Not ActiveWorkbook.Saved Then
MsgBox "Pls save " & vbNewLine & ActiveWorkbook.Name & vbNewLine & "before running this code"
Exit Sub
End If
With Application
.DisplayAlerts = False
.ScreenUpdating = False
lngCalc = .Calculation
.Calculation = xlCalculationManual
End With
'make output diretcories if they don't exist
If Dir(strMain, vbDirectory) = vbNullString Then MkDir strMain
If Dir(strZipped, vbDirectory) = vbNullString Then MkDir strZipped
For Each ws In ActiveWorkbook.Worksheets
Select Case ws.Name
Case "TOC", "Lookup"
'do nothing for these sheets
Case Else
ws.SaveAs strMain & ws.Name, xlCSV
End Select
Next
'section to run the zipping
Call NewZip(strZipped & strZipFile)
Application.Wait (Now + TimeValue("0:00:01"))
Call Zip_All_Files_in_Folder '(strZipped & strZipFile, strMain)
'end of zipping section
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.Calculation = lngCalc
End With
End Sub
'Create the ZIP file if it doesn't exist
Sub NewZip(sPath As String)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub
'Add the files to the Zip file
Sub Zip_All_Files_in_Folder() '(sPath As String, ByVal strMain)
Dim oApp As Object
Set oApp = CreateObject("Shell.Application")
'Shell doesn't handle the variable strings in my testing. So hardcode the same paths :(
sPath = "C:\zipcsv\MyZip.zip"
strMain = "c:\csv\"
'Copy the files to the compressed folder
oApp.Namespace(sPath).CopyHere oApp.Namespace(strMain).items
MsgBox "You find the zipfile here: " & sPath
End Sub
I am using the following code to refresh Excel pivot tables from an Access application. What is the best way to save and close the Excel app after the pivots refresh? In my last attempt the code was trying to save and close before the pivots had refreshed.
Private Sub Command161_Click()
Dim objXL As Object, x
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
With objXL.Application
.Visible = True
'Open the Workbook
.Workbooks.Open "myfilepath.xls"
'Refresh Pivots
x = .ActiveWorkbook.RefreshAll
End With
Set objXL = Nothing
End Sub
Set the pivottable.pivotcache.backgroundquery property to False for synchronous updates.