简体   繁体   中英

How to save excel row data "as is" to .svg using a VBA macro

I have a working VBA Macro but for the life of me I can't get it to completely work as expected. The macro saves row data to individual .svg files. Up to this point everything is fine. The problem is that I encountered an issue where the macro added double quotes to the .svg files thus ruining them. This was as a result of xlCSV but I changed this to xlTextPrinter . This worked but once again I encountered an issue where the svg code breaks where it's not supposed to. For example <ima ge style="overflow:visible;"style="overflow:visible;" width="1200" height="682" ... <ima ge style="overflow:visible;"style="overflow:visible;" width="1200" height="682" ...

which ruins the code when you preview it.

I am completely stuck at this point. I want the macro to print just what is in the rows and that's it without interfering.

The macro is this one:

Sub SaveRowsAsSVGs()

Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim r As Long, c As Long
Set wsSource = ThisWorkbook.Worksheets("Images")

Application.DisplayAlerts = False 'will overwrite existing files without asking
Application.ScreenUpdating = False

r = 1
Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
Set wsTemp = ThisWorkbook.Worksheets(1)

For c = 2 To 7
wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
Next c

wsTemp.Move
Set wbNew = ActiveWorkbook
Set wsTemp = wbNew.Worksheets(1)
Dim myPath As String
myPath = "C:\Users\myname\Desktop\MJOMBA\Images\"
wbNew.SaveAs myPath & wsSource.Cells(r, 1).Value & ".svg", xlTextPrinter
'wbNew.SaveAs "cell.Text" & r & ".svg", xlCSV 'new way
wbNew.Close
ThisWorkbook.Activate
r = r + 1
Loop

Application.DisplayAlerts = False
End Sub

This code solved my problem perfectly.

Sub Export_SVG_Files()
Dim sExportFolder, sFN
Dim rArticleName As Range
Dim rDisclaimer As Range
Dim oSh As Worksheet
Dim oFS As Object
Dim oTxt As Object

'sExportFolder = path to the folder you want to export to
'oSh = The sheet where your data is stored
sExportFolder = "C:\Users\myname\Desktop\NewFolder\Images"
Set oSh = ThisWorkbook.Worksheets("Images")

Set oFS = CreateObject("Scripting.Filesystemobject")

For Each rArticleName In oSh.UsedRange.Columns("A").Cells
    Set rDisclaimer = rArticleName.Offset(, 1)

    'Add .txt to the article name as a file name
    sFN = rArticleName.Value & ".svg"
    Set oTxt = oFS.OpenTextFile(sExportFolder & "\" & sFN, 2, True)
    oTxt.Write rDisclaimer.Value
    oTxt.Close
Next
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM