Reply to thread

Message

<blockquote data-quote="hasithayad" data-source="post: 28869915" data-attributes="member: 373872">මචන් බලපන් 1258, 1259 images දෙකම සෙට් වෙන්නේ 1258ට. 1093 j, images දෙකක් එකක් උඩ එකක් තියනවා. ඒවා නිසා වෙන්න ඕනෙ අවුල් යන්නෙ. මම [USER=582168]@EKGuest[/USER] ගේ කෝඩ් එක අප්ඩේට් කරා දාලා බලන්න. ඔක්කොම images 1178ක් සේව් වෙනවා[CODE]Dim shp As Shape, Temp As Object, tArea As Object, itemCodeColumn As String, saveInFolderName As StringitemImageColumn = &quot;G&quot;itemCodeColumn = &quot;A&quot;saveInFolderName = &quot;C:\Users\user\Documents\excel_img&quot;Application.ScreenUpdating = FalseMsgBox (&quot;Total Images: &quot; &amp; ActiveSheet.Shapes.Count)For Each shp In ActiveSheet.ShapesOn Error Resume Next&nbsp; &nbsp; If shp.TopLeftCell.Column = Range(itemImageColumn &amp; 1).Column Then&nbsp; &nbsp; &nbsp; &nbsp; If shp.Type = msoPicture Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; shp.Select&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Application.Selection.CopyPicture&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; DoEvents&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Set Temp = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Set tArea = Temp.Chart&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Temp.Activate&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If Dir(saveInFolderName &amp; &quot;\&quot; &amp; ActiveSheet.Range(itemCodeColumn &amp; shp.TopLeftCell.Row).Value &amp; &quot;.jpg&quot;) = &quot;&quot; Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; With tArea&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .ChartArea.Select&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Paste&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; .Export (saveInFolderName &amp; &quot;\&quot; &amp; ActiveSheet.Range(itemCodeColumn &amp; shp.TopLeftCell.Row).Value &amp; &quot;.jpg&quot;)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End With&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Else&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; MsgBox (&quot;Image Already exists: &quot; &amp; shp.TopLeftCell.Address)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Temp.Delete&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; DoEvents&nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; End IfIf Err.Number &gt; 0 Then&nbsp; &nbsp; MsgBox (&quot;Error: No-&quot; &amp; Err.Number &amp; vbCrLf &amp; Err.Description &amp; vbCrLf &amp; &quot;CELL: &quot; &amp; shp.TopLeftCell.Address)&nbsp; &nbsp; Err.ClearEnd IfNextMsgBox (&quot;Complete&quot;)[/CODE]</blockquote>

[QUOTE="hasithayad, post: 28869915, member: 373872"] මචන් බලපන් 1258, 1259 images දෙකම සෙට් වෙන්නේ 1258ට. 1093 j, images දෙකක් එකක් උඩ එකක් තියනවා. ඒවා නිසා වෙන්න ඕනෙ අවුල් යන්නෙ. මම [USER=582168]@EKGuest[/USER] ගේ කෝඩ් එක අප්ඩේට් කරා දාලා බලන්න. ඔක්කොම images 1178ක් සේව් වෙනවා [CODE] Dim shp As Shape, Temp As Object, tArea As Object, itemCodeColumn As String, saveInFolderName As String itemImageColumn = "G" itemCodeColumn = "A" saveInFolderName = "C:\Users\user\Documents\excel_img" Application.ScreenUpdating = False MsgBox ("Total Images: " & ActiveSheet.Shapes.Count) For Each shp In ActiveSheet.Shapes On Error Resume Next If shp.TopLeftCell.Column = Range(itemImageColumn & 1).Column Then If shp.Type = msoPicture Then shp.Select Application.Selection.CopyPicture DoEvents Set Temp = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height) Set tArea = Temp.Chart Temp.Activate If Dir(saveInFolderName & "\" & ActiveSheet.Range(itemCodeColumn & shp.TopLeftCell.Row).Value & ".jpg") = "" Then With tArea .ChartArea.Select .Paste .Export (saveInFolderName & "\" & ActiveSheet.Range(itemCodeColumn & shp.TopLeftCell.Row).Value & ".jpg") End With Else MsgBox ("Image Already exists: " & shp.TopLeftCell.Address) End If Temp.Delete DoEvents End If End If If Err.Number > 0 Then MsgBox ("Error: No-" & Err.Number & vbCrLf & Err.Description & vbCrLf & "CELL: " & shp.TopLeftCell.Address) Err.Clear End If Next MsgBox ("Complete") [/CODE] [/QUOTE]

Verification

Hath warak paha keeyada? (hatha wadikireema paha)

Search

Latest ads

Reply to thread