I need to extract photos from excel to a jpg file and simultaneously to take the alternative image text of the photo and save the jpg filename as the alt text.
i have xlsx . Files with rows with 1 small photo in every row and some product_iD price ... and all the photos have alternative text attribute as the product_code , the photos are placed in the cell of every row not as external link.
I need to extract from excel 2007 xlsx the photos from every row and simultaneously grab the alternative text of the photo (which is the product_ID) and make the photos to individual files with filename as the alternative text . And to do it batch- multiply in 1000 photos.
I need to extract from excel 2007 xlsx the photos from every row and simultaneously grab the alternative text of the photo (which is the product_ID) and make the photos to individual files with filename as the alternative text . And to do it batch- multiply in 1000 photos.
Put this code in the worksheet code module, change the constants as desired for your setup, and run the macro.
To add VBA code to a worksheet or chart code module in an Excel workbook, right-click on the worksheet or chart tab at the bottom of the window and select View Code. Paste the code into the document window that appears. Press ALT+F11 to return to the Excel workbook. To find a worksheet or chart module when already in the VBE, press CTRL+R to open the VBE project explorer. Find the module in which the code will be placed - each worksheet and chart module is pre-assigned a name such as "Sheet1 (Sheet1)" where the name inside the parenthesis is the tab name. Double-click the desired module and paste the code into the document window that appears. Press ALT+F11 to return to the Excel workbook.
Public Sub SaveImages()
Dim FileNumber As Long
Dim FileData As String
Dim RegExp As Object
Dim Matches As Object
Dim Index As Long
Const SaveAsLocation = "C:\Documents and Settings\Your Name\Desktop\"
Const FileName = "Temp.htm"
Const FolderName = "Temp_files"
Const ImagesFolderName = "Images"
On Error Resume Next
Kill SaveAsLocation & FileName
CreateObject("Scripting.Fi
CreateObject("Scripting.Fi
On Error GoTo 0
Me.Copy
ActiveWorkbook.SaveAs SaveAsLocation & FileName, FileFormat:=xlHtml
ActiveWorkbook.Close False
FileNumber = FreeFile
Open SaveAsLocation & FileName For Binary Access Read As FileNumber
FileData = StrConv(InputB(LOF(FileNum
Close FileNumber
Set RegExp = CreateObject("vbscript.reg
RegExp.Global = True
RegExp.MultiLine = True
RegExp.IgnoreCase = True
RegExp.Pattern = "src=""([^""]+)""\s+alt=""
On Error Resume Next
Set Matches = RegExp.Execute(FileData)
On Error GoTo 0
If Matches Is Nothing Then Exit Sub
If Matches.Count = 0 Then Exit Sub
MkDir SaveAsLocation & ImagesFolderName
For Index = 0 To Matches.Count - 1
FileCopy SaveAsLocation & Replace(Matches(Index).Sub
Next Index
On Error Resume Next
Kill SaveAsLocation & FileName
CreateObject("Scripting.Fi
On Error GoTo 0
End Sub
Kevin
To add VBA code to a worksheet or chart code module in an Excel workbook, right-click on the worksheet or chart tab at the bottom of the window and select View Code. Paste the code into the document window that appears. Press ALT+F11 to return to the Excel workbook. To find a worksheet or chart module when already in the VBE, press CTRL+R to open the VBE project explorer. Find the module in which the code will be placed - each worksheet and chart module is pre-assigned a name such as "Sheet1 (Sheet1)" where the name inside the parenthesis is the tab name. Double-click the desired module and paste the code into the document window that appears. Press ALT+F11 to return to the Excel workbook.
Public Sub SaveImages()
Dim FileNumber As Long
Dim FileData As String
Dim RegExp As Object
Dim Matches As Object
Dim Index As Long
Const SaveAsLocation = "C:\Documents and Settings\Your Name\Desktop\"
Const FileName = "Temp.htm"
Const FolderName = "Temp_files"
Const ImagesFolderName = "Images"
On Error Resume Next
Kill SaveAsLocation & FileName
CreateObject("Scripting.Fi
CreateObject("Scripting.Fi
On Error GoTo 0
Me.Copy
ActiveWorkbook.SaveAs SaveAsLocation & FileName, FileFormat:=xlHtml
ActiveWorkbook.Close False
FileNumber = FreeFile
Open SaveAsLocation & FileName For Binary Access Read As FileNumber
FileData = StrConv(InputB(LOF(FileNum
Close FileNumber
Set RegExp = CreateObject("vbscript.reg
RegExp.Global = True
RegExp.MultiLine = True
RegExp.IgnoreCase = True
RegExp.Pattern = "src=""([^""]+)""\s+alt=""
On Error Resume Next
Set Matches = RegExp.Execute(FileData)
On Error GoTo 0
If Matches Is Nothing Then Exit Sub
If Matches.Count = 0 Then Exit Sub
MkDir SaveAsLocation & ImagesFolderName
For Index = 0 To Matches.Count - 1
FileCopy SaveAsLocation & Replace(Matches(Index).Sub
Next Index
On Error Resume Next
Kill SaveAsLocation & FileName
CreateObject("Scripting.Fi
On Error GoTo 0
End Sub
Kevin
ASKER
i run the macro and for the 1st part worked very well
it created for every image 1 file .PNG and 1 file .GIF but the gif has corruption (view 1st attachment)
the 2nd is png and is good (view 2nd attachment).
the 2nd part to rename all saved images with filename taken from the alternative text of the image the makro didnt maked , do you have any suggestion.
it created for every image 1 file .PNG and 1 file .GIF but the gif has corruption (view 1st attachment)
the 2nd is png and is good (view 2nd attachment).
the 2nd part to rename all saved images with filename taken from the alternative text of the image the makro didnt maked , do you have any suggestion.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
excellent and fast answer
thanks zorvek the macro warked perfect
again I send hi from Greece
thanks zorvek the macro warked perfect
again I send hi from Greece
ASKER
some explanation
The fields in the photo are photos/ internet_code or product code / logistic code / manufacture / greek description / english description / availability / category-subcategory /
In the photos detailed info there is an attribute called alternative text (for the web) so i need to grab the alt text and give with this the filename of the photo that i have allready extracted .
thanks