A source code of ExportToJPG macro.
Help & contributing
You can use Microsoft Visual Basic for Applications (VBA) with WordPerfect Office. VBA is an object oriented programming language that lets you create VBA macros to automate tasks. You can, for example, create a macro in WordPerfect that changes the color of the headings. Using ExportEx and ExportBitmap methods in CorelDRAW 10 CorelDRAW 10 introduces a new way of exporting graphics into different format. Along with the old method Document.Export there are two new ones in the Document object - ExportEx and ExportBitmap:. Function ExportEx(ByVal FileName As String, ByVal Filter As cdrFilter, ByVal Range As cdrExportRange = cdrCurrentPage (1), ByVal Options As.
![Eps Eps](http://community.coreldraw.com/resized-image.ashx/__size/680x1000/__key/CommunityServer.Discussions.Components.Files/543/6518.eps-export.jpg)
There is a lot of code and other macros I want to open for free.
If you know VBA or C# and want to help, please contact me here or in twitter.
If you know VBA or C# and want to help, please contact me here or in twitter.
License
Copyright © 2016 Sancho
This program is free software: you can redistribute it and/or modifyit under the terms of the GNU General Public License as published bythe Free Software Foundation, either version 3 of the License, or(at your option) any later version.
This program is distributed in the hope that it will be useful,but WITHOUT ANY WARRANTY; without even the implied warranty ofMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See theGNU General Public License for more details.
You should have received a copy of the GNU General Public Licensealong with this program. If not, see http://www.gnu.org/licenses/.
Long story short the person that wrote that no longer works with us, I am very inexpeirenced in writing VBA's. He had a spreadsheet that I inserted a png.image into then used text boxes laid over with road #'s and field names. Then it has a export field command box that would export it to where it was supposed to go. I recently upgraded to Excel 2013 and this program no longer works, when I hit export field i receive a System Error &H80004008 (-2147467259) unspecified error. I will post the code he wrote. Any pointers will be extremely helpful.
Sub pasteField()
'Dim fieldnum As Integer
'fieldnum = ActiveSheet.Range('Q3').Value
'fieldnum = fieldnum + 1
'ActiveSheet.Range('Q3').Value = fieldnum
ActiveSheet.Range('Q3').ClearContents
Range('B3').Select
ActiveSheet.Paste
End Sub
Sub resizeField()
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 253.5
Selection.ShapeRange.Width = 253.5
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.ZOrder msoSendToBack
End Sub
'Private
Sub exportField()
Dim oRange As Range
Dim oCht As Chart
Dim oImg As Picture
Dim field1 As String
Dim field2 As String
'Make sure a grower is selected before exporting
If ActiveSheet.Range('Q3').Value = ' Then
MsgBox ('Please enter a valid field number before attempting to export.')
Exit Sub
Else
Application.ScreenUpdating = False
'Create file name for Grower files
If Range('S3').Value = ' Then
field1 = 'F:my DOCUMENTSGrowersGrowers' & ActiveSheet.Range('R3').Value & 'Field Maps' & ActiveSheet.Range('R3').Value & ' ' & ActiveSheet.Range('Q3').Value & '.png'
Else
field1 = 'F:my DOCUMENTSGrowersGrowers' & ActiveSheet.Range('R3').Value & 'Field Maps' & ActiveSheet.Range('R3').Value & ' ' & ActiveSheet.Range('Q3').Value & ' - ' & ActiveSheet.Range('S3').Value & '.png'
End If
'Create file name for Overall maps
field2 = 'F:my DOCUMENTSFieldsField Maps' & ActiveSheet.Range('Q3').Value & '.png'
'Check to see if file already exists in Grower files, if so deletes it so new file can be saved
If FileFolderExists(field1) Then
Kill (field1)
Else
End If
'Check to see if file already exists in Overall maps, if so deletes it so new file can be saved
If FileFolderExists(field2) Then
Kill (field2)
Else
End If
'Creates a chart within 'Area Map' Sheet and pastes the image in it
Set oRange = Range('B3:M17')
Set oCht = ActiveSheet.ChartObjects.Add(Left:=0, _
Top:=oRange.Top + oRange.Height + 10, _
Width:=oRange.Width, Height:=oRange.Height).Chart
With ActiveSheet.Shapes(oCht.Parent.Name)
.fill.Visible = msoFalse
.Line.Visible = msoFalse
End With
oRange.CopyPicture xlScreen, xlPicture
oCht.Paste
'Exports to Grower files
oCht.export Filename:=field1, Filtername:='png'
'Exports to Overall maps
oCht.export Filename:=field2, Filtername:='png'
'Deletes Chart from sheet
Dim wsItem As Worksheet
Dim chtObj As ChartObject
For Each wsItem In ThisWorkbook.Worksheets
For Each chtObj In wsItem.ChartObjects
chtObj.Delete
Next
Next
Application.ScreenUpdating = True
'Clears out grower name to prepare for next export
ActiveSheet.Range('Q3').ClearContents
End If
End Sub
Sub pasteField()
'Dim fieldnum As Integer
'fieldnum = ActiveSheet.Range('Q3').Value
'fieldnum = fieldnum + 1
'ActiveSheet.Range('Q3').Value = fieldnum
ActiveSheet.Range('Q3').ClearContents
Range('B3').Select
ActiveSheet.Paste
End Sub
Sub resizeField()
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 253.5
Selection.ShapeRange.Width = 253.5
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.ZOrder msoSendToBack
End Sub
'Private
Sub exportField()
Dim oRange As Range
Dim oCht As Chart
Dim oImg As Picture
Dim field1 As String
Dim field2 As String
'Make sure a grower is selected before exporting
If ActiveSheet.Range('Q3').Value = ' Then
MsgBox ('Please enter a valid field number before attempting to export.')
Exit Sub
Else
Application.ScreenUpdating = False
'Create file name for Grower files
If Range('S3').Value = ' Then
field1 = 'F:my DOCUMENTSGrowersGrowers' & ActiveSheet.Range('R3').Value & 'Field Maps' & ActiveSheet.Range('R3').Value & ' ' & ActiveSheet.Range('Q3').Value & '.png'
Else
field1 = 'F:my DOCUMENTSGrowersGrowers' & ActiveSheet.Range('R3').Value & 'Field Maps' & ActiveSheet.Range('R3').Value & ' ' & ActiveSheet.Range('Q3').Value & ' - ' & ActiveSheet.Range('S3').Value & '.png'
End If
'Create file name for Overall maps
field2 = 'F:my DOCUMENTSFieldsField Maps' & ActiveSheet.Range('Q3').Value & '.png'
'Check to see if file already exists in Grower files, if so deletes it so new file can be saved
If FileFolderExists(field1) Then
Kill (field1)
Else
End If
'Check to see if file already exists in Overall maps, if so deletes it so new file can be saved
If FileFolderExists(field2) Then
Kill (field2)
Else
End If
'Creates a chart within 'Area Map' Sheet and pastes the image in it
Set oRange = Range('B3:M17')
Set oCht = ActiveSheet.ChartObjects.Add(Left:=0, _
Top:=oRange.Top + oRange.Height + 10, _
Width:=oRange.Width, Height:=oRange.Height).Chart
With ActiveSheet.Shapes(oCht.Parent.Name)
.fill.Visible = msoFalse
.Line.Visible = msoFalse
End With
oRange.CopyPicture xlScreen, xlPicture
oCht.Paste
'Exports to Grower files
oCht.export Filename:=field1, Filtername:='png'
'Exports to Overall maps
oCht.export Filename:=field2, Filtername:='png'
'Deletes Chart from sheet
Dim wsItem As Worksheet
Dim chtObj As ChartObject
For Each wsItem In ThisWorkbook.Worksheets
For Each chtObj In wsItem.ChartObjects
chtObj.Delete
Next
Next
Application.ScreenUpdating = True
'Clears out grower name to prepare for next export
ActiveSheet.Range('Q3').ClearContents
End If
End Sub