Edit pictures

[HarryS]

In excell 2003 2007 2010 if you edit ... compress a picture pic1.jpg.... HOW CAN YOU SAVE THAT EDITED PICTURE TO A ANOTHER FILE ON DISK... Say as c:\newpics\PIC1Edited.jpg...... and ..is there VBA code for editing picture 2007 2010

 

[BrianB]

Nor sure what you want.
There is some code here that copies a worksheet picture to a file.
Can only be .bmp.

 

[HarryS]

Brian,
Thanks for the reply
I am not sure what code you sent or ore refering to..

My thoughts were wba code to ...
copy picture to clipboard as JGP
and then save this to a file
Help Please

 

[BrianB]

sorry missed the link out

http://www.mrexcel.com/forum/showthread.php?t=355239

 

[HarryS]

Brian, Thanks again for that...Jaffar's code has many references to BitMap constants... I can not as yet adjust it to give jpg.... H

 

[BrianB]

As explained in the code, I too spent a lot of time trying to get .jpg and failed.
Please let me know if you succeed.

 

[BrianB]

Just a thought. Here is some code that I used before I discovered the .bmp method. Using MS Paint (or any other picture application - with amendments) can save to any required format.

http://www.mrexcel.com/forum/showthread.php?t=344789

 

[HarryS]

Thanks .. all

Went to saving through excel chart properties

Sub SaveByChartX()
'Outline gets a new chart .. pastes the picture to it... saves picture..
' gives a compressed 200 dpi picture

Dim sh As Shape, SheetName$
' kill all charts on that sheet ...
For Each sh In Shapes
If sh.Type = 3 Then sh.Delete
Next sh
SheetName = ActiveSheet.Name
'add one chart to be ChartObjects(1).Chart
Charts.Add
With ActiveChart
.ChartType = xlXYScatter ' any type ?
.Location Where:=xlLocationAsObject, Name:=SheetName
End With
' pictw as picture obtained from file FilGotN as
'ActiveSheet.Pictures.Insert(FilGotN).Select
'Set Pictw = Selection
' or by copy etc... may be edited before copying to clipboard
Pictw.Copy ' get a copy of the picture if not on clipboard
ActiveChart.Paste ' put it on chart
'save it
ChartObjects(1).Chart.Export Filename:=Cells(4, 4), FilterName:="JPG"
End Sub

 

[HarryS]

Change of plot.... In a Chinese web ... found a neat trick of saving as web page... Works great with a few additions... and file deletions

' better to save as HTML ....as per
'http://cat14051.mysinablog.com/index.php?op=ViewArticle&articleId=72135
Sub SaveBySheetHtmlx()
Dim FilesN% ' count files
Pictw.Copy ' get working picture to clipboard
' from Emily's Blog put it to a new workbook
Set Wks = Workbooks.Add.Sheets(1)
Application.Goto Wks.Range("A1")
ActiveSheet.Paste
' the save will set up a html with images in PATH_files
' so delete these from previous saves to avoid overwrite questions
'ScriptFolderExists also counts files into filesN
If ScriptFolderExists("F:\compw\tempw_files", FilesN) Then
If FilesN > 0 Then Kill "F:\compw\tempw_files/*.*"
RmDir "F:\compw\tempw_files"
Kill "F:\compw\*.*"
End If
' this puts original as image001.jpg and image002.jpg in "F:\compw\tempw_files
Wks.SaveAs Filename:="f:\compw\TempW.htm", FileFormat:=xlHtml
Wks.Parent.Close False
'then fix the comments and tags etx fixCommentsSave below
End Sub
Sub fixCommentsSave()
Dim sz&, PathN$, PathTags$, PathTo$, idprog&, shs$
' the tags are not in image002 so move them from image001
PathN = "f:\compw\TempW_Files\image002.jpg"
PathTags = "f:\compw\TempW_Files\image001.jpg"
If ScriptFileExists(PathN, sz) Then
Cells(7, 4) = sz ' sz is the size
'exiftool -TagsFromFile src.jpg -all:all dst.jpg
'use exiftool to copy tags etc

shs = "c:\exift\exiftool.exe "
shs = shs & "-tagsFromFile " & Chr(34) & PathTags & Chr(34)
shs = shs & " -all:all "
shs = shs & Chr(34) & PathN & Chr(34)
Cells(14, 4) = shs ' to look at exif message
idprog = Shell(shs)
' to be sure that process has ended.. else goes on after excel is ended.
Iexit = IsRunning(idprog) ' standard exif wait until done
Else
Cells(7, 4) = " not found "
PathN = PathTags ' get original instead
End If
' copy image002.jpg to where it is needed cells(3,11) is path cells(4,11) is name
PathTo = Cells(3, 11) & "\" & Cells(4, 11) & ".jpg"
Cells(5, 11) = PathTo ' show what files
Cells(6, 11) = PathN
FileCopy PathN, PathTo

End Sub

 

[BrianB]

Thanks for the info.