Skip to content

Instantly share code, notes, and snippets.

@witwall witwall/svg.vba forked from wintercn/svg.vba
Created May 17, 2013

Embed
What would you like to do?
' svg.vba released 11.08.2002
Private Function get_export_scaling_factor() As Single
'' point to pixel conversion factor
get_export_scaling_factor = (4 / 3)
End Function
Private Function get_textbox_height_scaling_factor() As Single
'' point to pixel conversion factor, further scaled up by empirically derived factor, 1.3 too small, 1.5 unnecessarily large
get_textbox_height_scaling_factor = (4 / 3) * 1.4142
End Function
Private Function rgb_to_colour_hash(intRGB) As String
'' converts VBA RGB integer to #rrggbb format string
redRGB = Hex(intRGB Mod 256)
If Len(redRGB) = 1 Then
redRGB = "0" & redRGB
End If
greenRGB = Hex(intRGB \ 256 Mod 256)
If Len(greenRGB) = 1 Then
greenRGB = "0" & greenRGB
End If
blueRGB = Hex(intRGB \ 65536 Mod 256)
If Len(blueRGB) = 1 Then
blueRGB = "0" & blueRGB
End If
rgb_to_colour_hash = "#" & redRGB & greenRGB & blueRGB
End Function
Private Function get_points(ByVal s As shape, ByVal scale_factor As Single) As String
'' for any poly-object, creates a string of coord pairs
'' takes into account re-scaling of poly-object
'' why ppt keeps the creation size, goodness knows
''
'' get the original bounding box (bb)
numNodes = s.Nodes.Count
xyCoords = s.Vertices
largest_x = xyCoords(1, 1)
largest_y = xyCoords(1, 2)
For i = 2 To numNodes
If xyCoords(i, 1) > largest_x Then
largest_x = xyCoords(i, 1)
End If
If xyCoords(i, 2) > largest_y Then
largest_y = xyCoords(i, 2)
End If
Next
bb_x = largest_x - s.Left
bb_y = largest_y - s.Top
'' get the ratio, current to original
x_ratio = s.Width / bb_x
y_ratio = s.Height / bb_y
'' establish current top-left origin
x00Coord = (xyCoords(1, 1) - s.Left) * x_ratio
y00Coord = (xyCoords(1, 2) - s.Top) * y_ratio
'' establish current top-left corner
If s.HorizontalFlip Then
x = (s.Left + (s.Width - x00Coord)) * scale_factor
Else
x = (s.Left + x00Coord) * scale_factor
End If
If s.VerticalFlip Then
y = (s.Top + (s.Height - y00Coord)) * scale_factor
Else
y = (s.Top + y00Coord) * scale_factor
End If
strPoints = x & "," & y
'' build remaining points
For i = 2 To numNodes
x00Coord = (xyCoords(i, 1) - s.Left) * x_ratio
y00Coord = (xyCoords(i, 2) - s.Top) * y_ratio
If s.HorizontalFlip Then
x = (s.Left + (s.Width - x00Coord)) * scale_factor
Else
x = (s.Left + x00Coord) * scale_factor
End If
If s.VerticalFlip Then
y = (s.Top + (s.Height - y00Coord)) * scale_factor
Else
y = (s.Top + y00Coord) * scale_factor
End If
strPoints = strPoints & " " & x & "," & y
Next
get_points = strPoints
End Function
Private Function get_svg_line_colour_hash(ByVal s As shape) As String
'' get stroke (colour)
rgbLine = s.Line.ForeColor.RGB
hrgbLine = rgb_to_colour_hash(rgbLine)
get_svg_line_colour_hash = "stroke:" & hrgbLine & ";"
End Function
Private Function get_svg_line_width(ByVal s As shape) As String
'' get stroke-width
swLine = s.Line.Weight
get_svg_line_width = "stroke-width:" & swLine & "pt;"
End Function
Private Function get_svg_line_points(ByVal s As shape) As String
'' get points
export_scaling_factor = get_export_scaling_factor()
If s.HorizontalFlip Then
If s.VerticalFlip Then '' both flips
x1 = s.Left + s.Width
y1 = s.Top + s.Height
x2 = s.Left
y2 = s.Top
Else '' horizontal flip only
x1 = s.Left + s.Width
y1 = s.Top
x2 = s.Left
y2 = s.Top + s.Height
End If
Else '' vertical flip only
If s.VerticalFlip Then
x1 = s.Left
y1 = s.Top + s.Height
x2 = s.Left + s.Width
y2 = s.Top
Else '' no flip of any kind
x1 = s.Left
y1 = s.Top
x2 = s.Left + s.Width
y2 = s.Top + s.Height
End If
End If
x1 = Int(x1 * export_scaling_factor)
y1 = Int(y1 * export_scaling_factor)
x2 = Int(x2 * export_scaling_factor)
y2 = Int(y2 * export_scaling_factor)
get_svg_line_points = "x1=" & Chr$(34) & x1 & Chr$(34) & " y1=" & Chr$(34) & y1 & Chr$(34) & _
" x2=" & Chr$(34) & x2 & Chr$(34) & " y2=" & Chr$(34) & y2 & Chr$(34)
End Function
Private Function substr(ByVal t As String, ByVal f As String, ByVal r As String) As String
If InStr(1, r, f, vbTextCompare) > 0 Then
tStr = ""
tRem = t
posF = InStr(1, tRem, f, vbTextCompare)
While posF > 0
tStr = Left$(tRem, posF - 1) & r
tRem = Right$(tRem, Len(tRem) - (posF + Len(f) - 1))
posF = InStr(1, tRem, f, vbTextCompare)
Wend
tStr = tStr & tRem
Else
tStr = t
posF = InStr(1, tStr, f, vbTextCompare)
While posF > 0
tStr = Left$(tStr, posF - 1) & r & Right$(tStr, Len(tStr) - (posF + Len(f) - 1))
posF = InStr(1, tStr, f, vbTextCompare)
Wend
End If
substr = tStr
End Function
Private Function textbox_to_moz_svg(ByVal s As shape) As String
'' this function utter rot for code fragments
'' need to re-think text box output for moz
export_scaling_factor = get_export_scaling_factor()
x = Int(s.Left * export_scaling_factor)
y = Int(s.Top * export_scaling_factor)
w = Int(s.Width * export_scaling_factor) + 1
h = Int(s.Height * export_scaling_factor) + 1
'' get contents of text box
txtTextBox0 = s.TextFrame.TextRange.Text
txtTextBox1 = substr(txtTextBox0, "&", "&")
txtTextBox2 = substr(txtTextBox1, "<", "&lt;")
txtTextBox = substr(txtTextBox2, ">", "&gt;")
'' get font family
ffText = s.TextFrame.TextRange.Font.Name ' "Arial"
styFamily = "font-family:" & ffText & ";"
'' get font size
fsText = s.TextFrame.TextRange.Font.Size ' 12, 24,...
stySize = "font-size:" & fsText & "pt;"
'' get colour of font
rgbText = s.TextFrame.TextRange.Font.Color.RGB
hrgbText = rgb_to_colour_hash(rgbText)
styFill = "fill:" & hrgbText & ";"
'' get font attributes
fiText = s.TextFrame.TextRange.Font.Italic ' t/f
If fiText Then
styStyle = "font-style:italic;"
Else
styStyle = ""
End If
fbText = s.TextFrame.TextRange.Font.Bold ' t/f
If fbText Then
styWeight = "font-weight:bold;"
Else
styWeight = ""
End If
fuText = s.TextFrame.TextRange.Font.Underline ' t/f
If fuText Then
styDeco = "text-decoration:underline;"
Else
styDeco = ""
End If
h = Int(s.Height * 2) + 1 ' textbox_height_scaling_factor, or 2.0
h1 = s.Height * export_scaling_factor
svgTextBox = " <foreignObject xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _
" width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _
" style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtTextBox & _
"</foreignObject>"
textbox_to_moz_svg = svgTextBox
End Function
Private Function get_svg_rect_points(ByVal s As shape) As String
'' get points
export_scaling_factor = get_export_scaling_factor()
x = s.Left
y = s.Top
w = s.Width
h = s.Height
x = Int(x * export_scaling_factor)
y = Int(y * export_scaling_factor)
w = Int(w * export_scaling_factor)
h = Int(h * export_scaling_factor)
get_svg_rect_points = "x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _
" width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34)
End Function
Private Function get_svg_rect_fill(ByVal s As shape) As String
'' get fill colour
If s.Fill.Visible = msoFalse Then
hrgbRect = "transparent"
Else
rgbRect = s.Fill.ForeColor.RGB
hrgbRect = rgb_to_colour_hash(rgbRect)
End If
get_svg_rect_fill = "fill:" & hrgbRect & ";"
End Function
Private Function get_svg_rect_stroke_width(ByVal s As shape) As String
'' get stroke-width
swRect = s.Line.Weight
get_svg_rect_stroke_width = "stroke-width:" & swRect & "pt;"
End Function
Private Function get_svg_rect_stroke(ByVal s As shape) As String
'' get stroke (border colour)
If s.Line.Visible = msoFalse Then
hrgbStroke = "transparent"
Else
rgbStroke = s.Line.ForeColor.RGB
hrgbStroke = rgb_to_colour_hash(rgbStroke)
End If
get_svg_rect_stroke = "stroke:" & hrgbStroke & ";"
End Function
Private Function get_svg_ellipse_points(ByVal s As shape) As String
'' get points
export_scaling_factor = get_export_scaling_factor()
x = s.Left
y = s.Top
w = s.Width
h = s.Height
cx = Int((x + (w / 2)) * export_scaling_factor)
cy = Int((y + (h / 2)) * export_scaling_factor)
rx = Int((w / 2) * export_scaling_factor)
ry = Int((h / 2) * export_scaling_factor)
get_svg_ellipse_points = "cx=" & Chr$(34) & cx & Chr$(34) & " cy=" & Chr$(34) & cy & Chr$(34) & _
" rx=" & Chr$(34) & rx & Chr$(34) & " ry=" & Chr$(34) & ry & Chr$(34)
End Function
Private Function get_svg_ellipse_fill(ByVal s As shape) As String
'' get colour
If s.Fill.Visible = msoFalse Then
hrgbEllipse = "transparent"
Else
rgbEllipse = s.Fill.ForeColor.RGB
hrgbEllipse = rgb_to_colour_hash(rgbEllipse)
End If
get_svg_ellipse_fill = "fill:" & hrgbEllipse & ";"
End Function
Private Function get_svg_ellipse_stroke_width(ByVal s As shape) As String
'' get stroke-width
swEllipse = s.Line.Weight
get_svg_ellipse_stroke_width = "stroke-width:" & swEllipse & "pt;"
End Function
Private Function get_svg_ellipse_stroke(ByVal s As shape) As String
'' get stroke (border colour)
If s.Line.Visible = msoFalse Then
hrgbStroke = "transparent"
Else
rgbStroke = s.Line.ForeColor.RGB
hrgbStroke = rgb_to_colour_hash(rgbStroke)
End If
get_svg_ellipse_stroke = "stroke:" & hrgbStroke & ";"
End Function
Private Function get_svg_polygon_fill(ByVal s As shape) As String
'' get fill colour
If s.Fill.Visible = msoFalse Then
hrgbPolygon = "transparent"
Else
rgbPolygon = s.Fill.ForeColor.RGB
hrgbPolygon = rgb_to_colour_hash(rgbPolygon)
End If
get_svg_polygon_fill = "fill:" & hrgbPolygon & ";"
End Function
Private Function get_svg_polygon_stroke(ByVal s As shape) As String
'' get stroke (border colour)
If s.Line.Visible = msoFalse Then
hrgbPolygon = "transparent"
Else
rgbPolygon = s.Line.ForeColor.RGB
hrgbPolygon = rgb_to_colour_hash(rgbPolygon)
End If
get_svg_polygon_stroke = "stroke:" & hrgbPolygon & ";"
End Function
Private Function get_svg_polygon_stroke_width(ByVal s As shape) As String
'' get stroke-width
swPolygon = s.Line.Weight
get_svg_polygon_stroke_width = "stroke-width:" & swPolygon & "pt;"
End Function
Private Function get_svg_polygon_points(ByVal s As shape) As String
export_scaling_factor = get_export_scaling_factor()
strPoints = get_points(s, export_scaling_factor)
get_svg_polygon_points = "points=" & Chr$(34) & strPoints & Chr$(34)
End Function
Private Function get_svg_polyline_stroke(ByVal s As shape) As String
If s.Line.Visible = msoFalse Then
hrgbPolyline = "transparent"
Else
rgbPolyline = s.Line.ForeColor.RGB
hrgbPolyline = rgb_to_colour_hash(rgbPolyline)
End If
get_svg_polyline_stroke = "stroke:" & hrgbPolyline & ";"
End Function
Private Function get_svg_polyline_stroke_width(ByVal s As shape) As String
'' get stroke-width
swPolyline = s.Line.Weight
get_svg_polyline_stroke_width = "stroke-width:" & swPolyline & "pt;"
End Function
Private Function get_svg_polyline_points(ByVal s As shape) As String
'' get points
export_scaling_factor = get_export_scaling_factor()
strPoints = get_points(s, export_scaling_factor)
get_svg_polyline_points = "points=" & Chr$(34) & strPoints & Chr$(34)
End Function
Private Function get_asv_svg_polyline_segment_points(ByVal s As shape, ByVal j As Integer) As String
'' get segment points
export_scaling_factor = get_export_scaling_factor()
pairStart = s.Nodes.Item(j - 1).Points
pairEnd = s.Nodes.Item(j).Points
x1 = Int(pairStart(1, 1) * export_scaling_factor)
y1 = Int(pairStart(1, 2) * export_scaling_factor)
x2 = Int(pairEnd(1, 1) * export_scaling_factor)
y2 = Int(pairEnd(1, 2) * export_scaling_factor)
get_asv_svg_polyline_segment_points = "x1=" & Chr$(34) & x1 & Chr$(34) & " y1=" & Chr$(34) & y1 & Chr$(34) & _
" x2=" & Chr$(34) & x2 & Chr$(34) & " y2=" & Chr$(34) & y2 & Chr$(34)
End Function
Private Function polyline_to_asv_svg(ByVal s As shape) As String
svg_polyline_stroke_width = get_svg_polyline_stroke_width(s)
svg_polyline_stroke = get_svg_polyline_stroke(s)
If s.Line.BeginArrowheadStyle = msoArrowheadOval Then
marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then
marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadOval Then
marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then
marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
numNodes = s.Nodes.Count
If numNodes = 2 Then
svg_line_points = get_asv_svg_polyline_segment_points(s, 2)
svgPolyline = " <line " & svg_line_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_start & marker_end & "/>"
Else
svgPolyline = ""
For j = 2 To numNodes
svg_line_points = get_asv_svg_polyline_segment_points(s, j)
If j = 2 Then
svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_start & "/>" & vbCrLf
ElseIf j = numNodes Then
svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_end & "/>"
Else
svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & "/>" & vbCrLf
End If
svgPolyline = svgPolyline & svgLine
Next
End If
polyline_to_asv_svg = "<!-- " & s.Name & " (polyline_to_asv_svg) -->" & vbCrLf & svgPolyline
End Function
Private Function get_svg_path_stroke(ByVal s As shape) As String
rgbPath = s.Line.ForeColor.RGB
hrgbPath = rgb_to_colour_hash(rgbPath)
get_svg_path_stroke = "stroke:" & hrgbPath & ";"
End Function
Private Function get_svg_path_stroke_width(ByVal s As shape) As String
swPath = s.Line.Weight
get_svg_path_stroke_width = "stroke-width:" & swPath & "pt;"
End Function
Private Function get_svg_path_points(ByVal s As shape) As String
'' need to document theory behind this function properly
export_scaling_factor = get_export_scaling_factor()
numNodes = s.Nodes.Count
xyCoords = s.Vertices ' try vertices, easier
largest_x = xyCoords(1, 1)
largest_y = xyCoords(1, 2)
For i = 2 To numNodes
If xyCoords(i, 1) > largest_x Then
largest_x = xyCoords(i, 1)
End If
If xyCoords(i, 2) > largest_y Then
largest_y = xyCoords(i, 2)
End If
Next
bb_x = largest_x - s.Left
bb_y = largest_y - s.Top
x_ratio = s.Width / bb_x
y_ratio = s.Height / bb_y
x00Coord = (xyCoords(1, 1) - s.Left) * x_ratio
y00Coord = (xyCoords(1, 2) - s.Top) * y_ratio
If s.HorizontalFlip Then
x = (s.Left + (s.Width - x00Coord)) * export_scaling_factor
Else
x = (s.Left + x00Coord) * export_scaling_factor
End If
If s.VerticalFlip Then
y = (s.Top + (s.Height - y00Coord)) * export_scaling_factor
Else
y = (s.Top + y00Coord) * export_scaling_factor
End If
strPath = " M " & x & "," & y
For i = 2 To numNodes
x00Coord = (xyCoords(i, 1) - s.Left) * x_ratio
y00Coord = (xyCoords(i, 2) - s.Top) * y_ratio
If (i Mod 3) = 2 Then
strPath = strPath & " C "
End If
If s.HorizontalFlip Then
x = (s.Left + (s.Width - x00Coord)) * export_scaling_factor
Else
x = (s.Left + x00Coord) * export_scaling_factor
End If
If s.VerticalFlip Then
y = (s.Top + (s.Height - y00Coord)) * export_scaling_factor
Else
y = (s.Top + y00Coord) * export_scaling_factor
End If
strPath = strPath & " " & x & "," & y
Next
get_svg_path_points = "d=" & Chr$(34) & strPath & Chr$(34)
End Function
Private Function get_asv_svg_path_points(ByVal s As shape) As Variant
numNodes = s.Nodes.Count
ReDim strPath(1 To numNodes, 1 To 2) As Single
export_scaling_factor = get_export_scaling_factor()
xyCoords = s.Vertices
largest_x = xyCoords(1, 1)
largest_y = xyCoords(1, 2)
For i = 2 To numNodes
If xyCoords(i, 1) > largest_x Then
largest_x = xyCoords(i, 1)
End If
If xyCoords(i, 2) > largest_y Then
largest_y = xyCoords(i, 2)
End If
Next
bb_x = largest_x - s.Left
bb_y = largest_y - s.Top
x_ratio = s.Width / bb_x
y_ratio = s.Height / bb_y
x00Coord = (xyCoords(1, 1) - s.Left) * x_ratio
y00Coord = (xyCoords(1, 2) - s.Top) * y_ratio
If s.HorizontalFlip Then
x = (s.Left + (s.Width - x00Coord)) * export_scaling_factor
Else
x = (s.Left + x00Coord) * export_scaling_factor
End If
If s.VerticalFlip Then
y = (s.Top + (s.Height - y00Coord)) * export_scaling_factor
Else
y = (s.Top + y00Coord) * export_scaling_factor
End If
strPath(1, 1) = x
strPath(1, 2) = y
For i = 2 To numNodes
x00Coord = (xyCoords(i, 1) - s.Left) * x_ratio
y00Coord = (xyCoords(i, 2) - s.Top) * y_ratio
If s.HorizontalFlip Then
x = (s.Left + (s.Width - x00Coord)) * export_scaling_factor
Else
x = (s.Left + x00Coord) * export_scaling_factor
End If
If s.VerticalFlip Then
y = (s.Top + (s.Height - y00Coord)) * export_scaling_factor
Else
y = (s.Top + y00Coord) * export_scaling_factor
End If
strPath(i, 1) = x
strPath(i, 2) = y
Next
get_asv_svg_path_points = strPath
End Function
Private Function curve_to_asv_svg(ByVal s As shape) As String
'' this now redundant (?)
svg_path_stroke_width = get_svg_path_stroke_width(s)
svg_path_stroke = get_svg_path_stroke(s)
If s.Line.BeginArrowheadStyle = msoArrowheadOval Then
marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then
marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadOval Then
marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then
marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
Dim svg_path_points As Variant
svg_path_points = get_asv_svg_path_points(s)
svgCurve = ""
numNodes = s.Nodes.Count
For j = 2 To numNodes
svg_line_points = "x1=" & Chr$(34) & svg_path_points(j - 1, 1) & Chr$(34) & _
" y1=" & Chr$(34) & svg_path_points(j - 1, 2) & Chr$(34) & _
" x2=" & Chr$(34) & svg_path_points(j, 1) & Chr$(34) & _
" y2=" & Chr$(34) & svg_path_points(j, 2) & Chr$(34)
If j = 2 Then
svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_path_stroke & svg_path_stroke_width & Chr$(34) & marker_start & "/>" & vbCrLf
ElseIf j = numNodes Then
svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_path_stroke & svg_path_stroke_width & Chr$(34) & marker_end & "/>"
Else
svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_path_stroke & svg_path_stroke_width & Chr$(34) & "/>" & vbCrLf
End If
svgCurve = svgCurve & svgLine
Next
curve_to_asv_svg = svgCurve
End Function
Private Function decompose_group(ByVal s As shape, ByVal svgSymbol As String, ByVal hier As Integer) As String
'' need to bring up-to-date with main export_to_svg procedure
tfRotation = False
numShapes = s.GroupItems.Count
For i = 1 To numShapes
Set sr = s.GroupItems(i)
If sr.Rotation <> 0 Then
tfRotation = True
End If
If sr.Type = msoGroup Then
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & " <!--g> < hier = " & hier & " -->"
hier = hier + 1
svgSymbol = decompose_group(sr, svgSymbol, hier)
hier = hier - 1
svgSymbol = svgSymbol & vbCrLf & indent & " <!--/g-->"
ElseIf sr.Type = msoLine Then
svgLine = line_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgLine
ElseIf sr.Type = msoTextBox Then
svgTextBox = textbox_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgTextBox
ElseIf sr.Type = msoFreeform Then
numNodes = sr.Nodes.Count
srCoords = sr.Vertices
If UBound(srCoords, 1) = (numNodes + 1) Then
'' closed polyline or polygon
svgPolygon = polygon_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon
Else ' not a closed poly-object
If sr.Nodes.Item(1).SegmentType = msoSegmentLine Then
If sr.Fill.Visible Then
'' polyline with fill
svgPolygon = polyline_filled_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon
Else
'' polyline
svgPolyline = polyline_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPolyline
End If
Else ' msoSegmentCurve
svgPath = curve_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPath
End If
End If
ElseIf sr.Type = msoAutoShape Then
If sr.AutoShapeType = msoShapeRectangle Then
svgRect = rect_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgRect
ElseIf sr.AutoShapeType = msoShapeOval Then
svgEllipse = ellipse_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgEllipse
Else
End If
Else
End If
Next
If tfRotation = True Then
End If
decompose_group = svgSymbol
End Function
Private Function moz_decompose_group(ByVal s As shape, ByVal svgSymbol As String, ByVal hier As Integer) As String
'' need to bring up-to-date with main export_to_svg procedure
tfRotation = False
numShapes = s.GroupItems.Count
For i = 1 To numShapes
Set sr = s.GroupItems(i)
If sr.Rotation <> 0 Then
tfRotation = True
End If
If sr.Type = msoGroup Then
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & " <!--g> < hier = " & hier & " -->"
hier = hier + 1
svgSymbol = moz_decompose_group(sr, svgSymbol, hier)
hier = hier - 1
svgSymbol = svgSymbol & vbCrLf & indent & " <!--/g-->"
ElseIf sr.Type = msoLine Then
msgText = sr.Name & " is line"
svgLine = line_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgLine
ElseIf sr.Type = msoTextBox Then
msgText = sr.Name & " is text"
moz_svgTextBox = textbox_to_moz_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & moz_svgTextBox
ElseIf sr.Type = msoFreeform Then
numNodes = sr.Nodes.Count
srCoords = sr.Vertices
If UBound(srCoords, 1) = (numNodes + 1) Then
'' closed polyline or polygon
svgPolygon = polygon_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon
Else ' not a closed poly-object
If sr.Nodes.Item(1).SegmentType = msoSegmentLine Then
If sr.Fill.Visible Then
'' polyline with fill
svgPolygon = polyline_filled_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon
Else
'' polyline
svgPolyline = polyline_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPolyline
End If
Else ' msoSegmentCurve
msgText = sr.Name & " is path"
svgPath = curve_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPath
End If
End If
ElseIf sr.Type = msoAutoShape Then
If sr.AutoShapeType = msoShapeRectangle Then
svgRect = rect_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgRect
ElseIf sr.AutoShapeType = msoShapeOval Then
svgEllipse = ellipse_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgEllipse
Else
End If
Else
End If
Next
If tfRotation = True Then
End If
moz_decompose_group = svgSymbol
End Function
Private Function asv_decompose_group(ByVal s As shape, ByVal svgSymbol As String, ByVal hier As Integer) As String
'' need to bring up-to-date with main export_to_svg procedure
tfRotation = False
numShapes = s.GroupItems.Count
For i = 1 To numShapes
Set sr = s.GroupItems(i)
If sr.Rotation <> 0 Then
tfRotation = True
End If
If sr.Type = msoGroup Then
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & " <!--g> < hier = " & hier & " -->"
hier = hier + 1
svgSymbol = asv_decompose_group(sr, svgSymbol, hier)
hier = hier - 1
svgSymbol = svgSymbol & vbCrLf & indent & " <!--/g-->"
ElseIf sr.Type = msoLine Then
svgLine = line_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgLine
ElseIf sr.Type = msoTextBox Then
svgTextBox = textbox_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgTextBox
ElseIf sr.Type = msoFreeform Then
numNodes = sr.Nodes.Count
srCoords = sr.Vertices
If UBound(srCoords, 1) = (numNodes + 1) Then
'' closed polyline or polygon
svgPolygon = polygon_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon
Else ' not a closed poly-object
If sr.Nodes.Item(1).SegmentType = msoSegmentLine Then
If sr.Fill.Visible Then
'' polyline with fill
svgPolygon = polyline_filled_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon
Else
asv_svgPolyline = polyline_to_asv_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & asv_svgPolyline
End If
Else ' msoSegmentCurve
msgText = sr.Name & " is path"
asv_svgPath = curve_to_asv_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & asv_svgPath
End If
End If
ElseIf sr.Type = msoAutoShape Then
If sr.AutoShapeType = msoShapeRectangle Then
svgRect = rect_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgRect
ElseIf sr.AutoShapeType = msoShapeOval Then
svgEllipse = ellipse_to_svg(sr)
indent = String((hier * 2), " ")
svgSymbol = svgSymbol & vbCrLf & indent & svgEllipse
Else
End If
Else
End If
Next
If tfRotation = True Then
End If
asv_decompose_group = svgSymbol
End Function
Private Function create_defs_text()
'' black markers - this could be made cleverer by dynamically writing the SVG as an arrow'ed object is encountered
txtDefs = " <defs>" & vbCrLf
txtDefs = txtDefs & " <marker id=" & Chr$(34) & "Triangle" & Chr$(34) & vbCrLf
txtDefs = txtDefs & " viewBox=" & Chr$(34) & "-10 0 10 10" & Chr$(34) & " refX=" & Chr$(34) & "0" & Chr$(34) & " refY=" & Chr$(34) & "5" & Chr$(34) & vbCrLf
txtDefs = txtDefs & " markerUnits = " & Chr$(34) & "strokeWidth" & Chr$(34) & vbCrLf
txtDefs = txtDefs & " markerWidth=" & Chr$(34) & "8" & Chr$(34) & " markerHeight=" & Chr$(34) & "6" & Chr$(34) & vbCrLf
txtDefs = txtDefs & " orient=" & Chr$(34) & "auto" & Chr$(34) & " style=" & Chr$(34) & "fill:3F80CD;" & Chr$(34) & ">" & vbCrLf
txtDefs = txtDefs & " <polygon points=" & Chr$(34) & "-15,0 1,5 -15,10" & Chr$(34) & " />" & vbCrLf
txtDefs = txtDefs & " </marker>" & vbCrLf
txtDefs = txtDefs & " <marker id=" & Chr$(34) & "Circle" & Chr$(34) & vbCrLf
txtDefs = txtDefs & " viewBox=" & Chr$(34) & "0 0 10 10" & Chr$(34) & " refX=" & Chr$(34) & "0" & Chr$(34) & " refY=" & Chr$(34) & "5" & Chr$(34) & vbCrLf
txtDefs = txtDefs & " markerUnits = " & Chr$(34) & "strokeWidth" & Chr$(34) & vbCrLf
txtDefs = txtDefs & " markerWidth=" & Chr$(34) & "8" & Chr$(34) & " markerHeight=" & Chr$(34) & "6" & Chr$(34) & vbCrLf
txtDefs = txtDefs & " orient=" & Chr$(34) & "auto" & Chr$(34) & " style=" & Chr$(34) & "fill:black;" & Chr$(34) & ">" & vbCrLf
txtDefs = txtDefs & " <circle cx=" & Chr$(34) & "5" & Chr$(34) & " cy=" & Chr$(34) & "5" & Chr$(34) & " r=" & Chr$(34) & "4" & Chr$(34) & " />" & vbCrLf
txtDefs = txtDefs & " </marker>" & vbCrLf
create_defs_text = txtDefs & " </defs>"
End Function
Private Function line_to_svg(ByVal s As shape) As String
svg_line_points = get_svg_line_points(s)
svg_line_colour = get_svg_line_colour_hash(s)
svg_line_width = get_svg_line_width(s)
If s.Line.BeginArrowheadStyle = msoArrowheadOval Then
marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then
marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadOval Then
marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then
marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_line_colour & svg_line_width & Chr$(34) & marker_start & marker_end & "/>"
line_to_svg = svgLine
End Function
Private Function shape_text_to_svg(ByVal s As shape) As String
export_scaling_factor = get_export_scaling_factor()
vertical_offset = s.TextFrame.TextRange.Font.Size
x = Int(s.Left * export_scaling_factor)
y = Int(s.Top * export_scaling_factor) + vertical_offset
w = Int(s.Width * export_scaling_factor) + 1
h = Int(s.Height * export_scaling_factor) + 1
'' get contents of text box
txtTextBox = s.TextFrame.TextRange.Text
'' get font family
ffText = s.TextFrame.TextRange.Font.Name ' "Arial"
styFamily = "font-family:" & ffText & ";"
'' get font size
fsText = s.TextFrame.TextRange.Font.Size ' 12, 24,...
stySize = "font-size:" & fsText & "pt;"
'' get colour of font
rgbText = s.TextFrame.TextRange.Font.Color.RGB
hrgbText = rgb_to_colour_hash(rgbText)
styFill = "fill:" & hrgbText & ";"
'' get font attributes
fiText = s.TextFrame.TextRange.Font.Italic ' t/f
If fiText Then
styStyle = "font-style:italic;"
Else
styStyle = ""
End If
fbText = s.TextFrame.TextRange.Font.Bold ' t/f
If fbText Then
styWeight = "font-weight:bold;"
Else
styWeight = ""
End If
fuText = s.TextFrame.TextRange.Font.Underline ' t/f
If fuText Then
styDeco = "text-decoration:underline;"
Else
styDeco = ""
End If
'' determine num of lines - this allows the use of tspan in the svg
'' thus it supports multi-line text boxes
numLines = 1
txtLine = s.TextFrame.TextRange.Lines(1)
While txtLine <> ""
numLines = numLines + 1
txtLine = s.TextFrame.TextRange.Lines(numLines)
Wend
numLines = numLines - 1
If numLines > 1 Then
''txtTextBox = s.TextFrame.TextRange.Lines(1)
txtLine0 = s.TextFrame.TextRange.Lines(1)
txtLine1 = substr(txtLine0, "&", "&amp;")
txtLine2 = substr(txtLine1, "<", "&lt;")
txtTextBox = substr(txtLine2, ">", "&gt;")
dy = Int(fsText * export_scaling_factor) + 1
For i = 2 To numLines
''txtLine = s.TextFrame.TextRange.Lines(i)
txtLine0 = s.TextFrame.TextRange.Lines(i)
txtLine1 = substr(txtLine0, "&", "&amp;")
txtLine2 = substr(txtLine1, "<", "&lt;")
txtLine = substr(txtLine2, ">", "&gt;")
txtTextBoxLine = " <tspan x=" & Chr$(34) & x & Chr$(34) & " dy=" & Chr$(34) & dy & Chr$(34) & ">" & txtLine & "</tspan>"
txtTextBox = txtTextBox & vbCrLf & txtTextBoxLine
Next
svgTextBox = " <text xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _
" width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _
" style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtTextBox & "</text>"
Else '' single-line text box
txtLine0 = s.TextFrame.TextRange.Lines(1)
txtLine1 = substr(txtLine0, "&", "&amp;")
txtLine2 = substr(txtLine1, "<", "&lt;")
txtLine = substr(txtLine2, ">", "&gt;")
svgTextBox = " <text xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _
" width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _
" style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtLine & "</text>"
End If
textbox_to_svg = svgTextBox
End Function
Private Function textbox_to_svg(ByVal s As shape) As String
export_scaling_factor = get_export_scaling_factor()
vertical_offset = s.TextFrame.TextRange.Font.Size
x = Int(s.Left * export_scaling_factor)
y = Int(s.Top * export_scaling_factor) + vertical_offset
w = Int(s.Width * export_scaling_factor) + 1
h = Int(s.Height * export_scaling_factor) + 1
'' get contents of text box
txtTextBox = s.TextFrame.TextRange.Text
'' get font family
ffText = s.TextFrame.TextRange.Font.Name ' "Arial"
styFamily = "font-family:" & ffText & ";"
'' get font size
fsText = s.TextFrame.TextRange.Font.Size ' 12, 24,...
stySize = "font-size:" & fsText & "pt;"
'' get colour of font
rgbText = s.TextFrame.TextRange.Font.Color.RGB
hrgbText = rgb_to_colour_hash(rgbText)
styFill = "fill:" & hrgbText & ";"
'' get font attributes
fiText = s.TextFrame.TextRange.Font.Italic ' t/f
If fiText Then
styStyle = "font-style:italic;"
Else
styStyle = ""
End If
fbText = s.TextFrame.TextRange.Font.Bold ' t/f
If fbText Then
styWeight = "font-weight:bold;"
Else
styWeight = ""
End If
fuText = s.TextFrame.TextRange.Font.Underline ' t/f
If fuText Then
styDeco = "text-decoration:underline;"
Else
styDeco = ""
End If
'' determine num of lines - this allows the use of tspan in the svg
'' thus it supports multi-line text boxes
numLines = 1
txtLine = s.TextFrame.TextRange.Lines(1)
While txtLine <> ""
numLines = numLines + 1
txtLine = s.TextFrame.TextRange.Lines(numLines)
Wend
numLines = numLines - 1
If numLines > 1 Then
''txtTextBox = s.TextFrame.TextRange.Lines(1)
txtLine0 = s.TextFrame.TextRange.Lines(1)
txtLine1 = substr(txtLine0, "&", "&amp;")
txtLine2 = substr(txtLine1, "<", "&lt;")
txtTextBox = substr(txtLine2, ">", "&gt;")
dy = Int(fsText * export_scaling_factor) + 1
For i = 2 To numLines
''txtLine = s.TextFrame.TextRange.Lines(i)
txtLine0 = s.TextFrame.TextRange.Lines(i)
txtLine1 = substr(txtLine0, "&", "&amp;")
txtLine2 = substr(txtLine1, "<", "&lt;")
txtLine = substr(txtLine2, ">", "&gt;")
txtTextBoxLine = " <tspan x=" & Chr$(34) & x & Chr$(34) & " dy=" & Chr$(34) & dy & Chr$(34) & ">" & txtLine & "</tspan>"
txtTextBox = txtTextBox & vbCrLf & txtTextBoxLine
Next
svgTextBox = " <text xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _
" width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _
" style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtTextBox & "</text>"
Else '' single-line text box
txtLine0 = s.TextFrame.TextRange.Lines(1)
txtLine1 = substr(txtLine0, "&", "&amp;")
txtLine2 = substr(txtLine1, "<", "&lt;")
txtLine = substr(txtLine2, ">", "&gt;")
svgTextBox = " <text xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _
" width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _
" style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtLine & "</text>"
End If
textbox_to_svg = svgTextBox
End Function
Private Function curve_to_svg(ByVal s As shape) As String
svg_path_points = get_svg_path_points(s)
svg_path_stroke_width = get_svg_path_stroke_width(s)
svg_path_stroke = get_svg_path_stroke(s)
If s.Line.BeginArrowheadStyle = msoArrowheadOval Then
marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then
marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadOval Then
marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then
marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
curve_to_svg = " <path " & svg_path_points & " style=" & Chr$(34) & "fill:transparent;" & svg_path_stroke & svg_path_stroke_width & Chr$(34) & marker_start & marker_end & "/>"
End Function
Private Function polyline_to_svg(ByVal s As shape) As String
svg_polyline_points = get_svg_polyline_points(s)
svg_polyline_stroke_width = get_svg_polyline_stroke_width(s)
svg_polyline_stroke = get_svg_polyline_stroke(s)
If s.Line.BeginArrowheadStyle = msoArrowheadOval Then
marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then
marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadOval Then
marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then
marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
polyline_to_svg = " <polyline " & svg_polyline_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_start & marker_end & "/>"
End Function
Private Function polyline_filled_to_svg(ByVal s As shape) As String
svg_polyline_points = get_svg_polyline_points(s)
svg_polygon_fill = get_svg_polygon_fill(s)
svg_polyline_stroke_width = get_svg_polyline_stroke_width(s)
svg_polyline_stroke = get_svg_polyline_stroke(s)
If s.Line.BeginArrowheadStyle = msoArrowheadOval Then
marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then
marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadOval Then
marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34)
End If
If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then
marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34)
End If
polyline_filled_to_svg = " <polyline " & svg_polyline_points & " style=" & Chr$(34) & svg_polygon_fill & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_start & marker_end & "/>"
End Function
Private Function polygon_to_svg(ByVal s As shape) As String
svg_polygon_points = get_svg_polygon_points(s)
svg_polygon_fill = get_svg_polygon_fill(s)
svg_polygon_stroke_width = get_svg_polygon_stroke_width(s)
svg_polygon_stroke = get_svg_polygon_stroke(s)
polygon_to_svg = " <polygon " & svg_polygon_points & " style=" & Chr$(34) & svg_polygon_fill & svg_polygon_stroke & svg_polygon_stroke_width & Chr$(34) & "/>"
End Function
Private Function rect_to_svg(ByVal s As shape) As String
svg_rect_points = get_svg_rect_points(s)
svg_rect_fill = get_svg_rect_fill(s)
svg_rect_stroke_width = get_svg_rect_stroke_width(s)
svg_rect_stroke = get_svg_rect_stroke(s)
rect_to_svg = " <rect " & svg_rect_points & " style=" & Chr$(34) & svg_rect_fill & svg_rect_stroke & svg_rect_stroke_width & Chr$(34) & "/>"
End Function
Private Function ellipse_to_svg(ByVal s As shape) As String
svg_ellipse_points = get_svg_ellipse_points(s)
svg_ellipse_fill = get_svg_ellipse_fill(s)
svg_ellipse_stroke_width = get_svg_ellipse_stroke_width(s)
svg_ellipse_stroke = get_svg_ellipse_stroke(s)
ellipse_to_svg = " <ellipse " & svg_ellipse_points & " style=" & Chr$(34) & svg_ellipse_fill & svg_ellipse_stroke & svg_ellipse_stroke_width & Chr$(34) & "/>"
End Function
Sub export_to_svg()
'' before release find a way to parameterise these variables
fnAsv = "export.asv.svg"
fnSvg = "export.svg"
fnXML = "export.svg.xml"
Set propsDoc = Application.ActivePresentation.BuiltInDocumentProperties
titleDoc = "svg" ''propsDoc.Item("Title")
descDoc = propsDoc.Item("Comments")
Open fnXML For Output As #2
Print #2, " <svg xmlns=" & Chr$(34) & "http://www.w3.org/2000/svg" & Chr$(34) & _
" width=" & Chr$(34); "2048" & Chr$(34) & " height=" & Chr$(34) & "1536" & Chr$(34) & ">"
Print #2, " <title>" & titleDoc & "</title>"
Print #2, " <desc>" & descDoc & "</desc>"
txtDefs = create_defs_text()
Print #2, txtDefs
Set myDocument = ActivePresentation.Slides(1)
tfRotation = False
tfSymbol = False
numShapes = myDocument.Shapes.Count
For i = 1 To numShapes
Set s = myDocument.Shapes(i)
If s.Rotation <> 0 Then
tfRotation = True
End If
If s.Type = msoGroup Then
tfSymbol = True
svgGroup = "" '' " <!--g-->"
moz_svgGroup = "" '' " <!--g-->"
asv_svgGroup = "" '' " <!--g-->"
hier = 1
svgGroup = decompose_group(s, svgGroup, hier)
moz_svgGroup = moz_decompose_group(s, moz_svgGroup, hier)
asv_svgGroup = asv_decompose_group(s, asv_svgGroup, hier)
Print #2, moz_svgGroup & vbCrLf & " <!--/g-->"
ElseIf s.Type = msoLine Then
svgLine = line_to_svg(s)
Print #2, svgLine
ElseIf s.Type = msoTextBox Then
svgTextBox = textbox_to_svg(s)
moz_svgTextBox = textbox_to_moz_svg(s)
Print #2, moz_svgTextBox
ElseIf s.Type = msoFreeform Then
numNodes = s.Nodes.Count
sCoords = s.Vertices
If UBound(sCoords, 1) = (numNodes + 1) Then
'' closed polyline or polygon
svgPolygon = polygon_to_svg(s)
Print #2, svgPolygon
Else ' not a closed poly-object
If s.Nodes.Item(1).SegmentType = msoSegmentLine Then
If s.Fill.Visible Then
'' polyline with fill
svgPolygon = polyline_filled_to_svg(s)
Print #2, svgPolygon
Else
'' polyline
svgPolyline = polyline_to_svg(s)
Print #2, svgPolyline
End If
Else ' msoSegmentCurve
svgPath = curve_to_svg(s)
Print #2, svgPath
End If
End If
ElseIf s.Type = msoAutoShape Then
If s.AutoShapeType = msoShapeRectangle Then
svgRect = rect_to_svg(s)
Print #2, svgRect
ElseIf s.AutoShapeType = msoShapeOval Then
svgEllipse = ellipse_to_svg(s)
Print #2, svgEllipse
Else
msgText = s.Name & " is unknown AutoShape"
End If
Else
msgText = s.Name & " is unknown Shape"
End If
Next
Print #2, " </svg>"
Close #2
If tfRotation = True Then
End If
If tfSymbol = True Then
End If
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.