Reply to thread

Message

<blockquote data-quote="EKGuest" data-source="post: 28869759" data-attributes="member: 582168">මචන් [USER=373872]@hasithayad[/USER]&nbsp; ගේ VBA කෝඩ් එකෙන් එකේ හැම ඉමේජ් එකක්ම සේව් කරගන්න පුලුවන්. මම ඒ කෝඩ් එකම පොඩ්ඩක් වෙනස් කලා එක එක ඉමේජ් එක අදාල Item Code එකේ නමින් සේව් වෙන්න. උදාහරණයක් විදියට S004.jpg කියලා සේව් වෙන්නේ ඒ Item Code එකට අදාල ඉමේජ් එක.මේකේ itemImageColumn එකට ඉමේජ් එක තියන කොලම් එකේ නම දෙන්න. itemCodeColumn වලට Item Code එක තියෙන කොලම් එකේ නම දෙන්න. saveInFolderName වලට ඉමේජ් ටික සේව් කරන්න ඕනෑ ෆොල්ඩර් එකේ පාත් එක දෙන්න.[CODE] Sub SaveImages()&nbsp; &nbsp; Dim shp As Shape, ImageName As String, Temp As Object, tArea As Object, _&nbsp; &nbsp; &nbsp; &nbsp; itemCodeColumn As String, saveInFolderName As String&nbsp;&nbsp; &nbsp; &nbsp; itemImageColumn = &quot;G&quot;&nbsp; &nbsp; itemCodeColumn = &quot;A&quot;&nbsp; &nbsp; saveInFolderName = &quot;C:\Users\Public\Images&quot;&nbsp;&nbsp; &nbsp; &nbsp; Application.ScreenUpdating = False&nbsp; &nbsp; For Each shp In ActiveSheet.Shapes&nbsp; &nbsp; &nbsp; &nbsp; If shp.TopLeftCell.Column = Range(itemImageColumn &amp; 1).Column Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If shp.Type = msoPicture Then&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; shp.Select&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Application.Selection.CopyPicture&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Set Temp = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Set tArea = Temp.Chart&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Temp.Activate&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; &nbsp; &nbsp; Temp.Delete&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; DoEvents&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; &nbsp; &nbsp; End If&nbsp; &nbsp; NextEnd Sub[/CODE]</blockquote>

[QUOTE="EKGuest, post: 28869759, member: 582168"] මචන් [USER=373872]@hasithayad[/USER] ගේ VBA කෝඩ් එකෙන් එකේ හැම ඉමේජ් එකක්ම සේව් කරගන්න පුලුවන්. මම ඒ කෝඩ් එකම පොඩ්ඩක් වෙනස් කලා එක එක ඉමේජ් එක අදාල Item Code එකේ නමින් සේව් වෙන්න. උදාහරණයක් විදියට S004.jpg කියලා සේව් වෙන්නේ ඒ Item Code එකට අදාල ඉමේජ් එක. මේකේ itemImageColumn එකට ඉමේජ් එක තියන කොලම් එකේ නම දෙන්න. itemCodeColumn වලට Item Code එක තියෙන කොලම් එකේ නම දෙන්න. saveInFolderName වලට ඉමේජ් ටික සේව් කරන්න ඕනෑ ෆොල්ඩර් එකේ පාත් එක දෙන්න. [CODE] Sub SaveImages() Dim shp As Shape, ImageName As String, Temp As Object, tArea As Object, _ itemCodeColumn As String, saveInFolderName As String itemImageColumn = "G" itemCodeColumn = "A" saveInFolderName = "C:\Users\Public\Images" Application.ScreenUpdating = False For Each shp In ActiveSheet.Shapes If shp.TopLeftCell.Column = Range(itemImageColumn & 1).Column Then If shp.Type = msoPicture Then shp.Select Application.Selection.CopyPicture Set Temp = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height) Set tArea = Temp.Chart Temp.Activate With tArea .ChartArea.Select .Paste .Export (saveInFolderName & "\" & ActiveSheet.Range(itemCodeColumn & shp.TopLeftCell.Row).Value & ".jpg") End With Temp.Delete DoEvents End If End If Next End Sub[/CODE] [/QUOTE]

Verification

Winadiyakata thappara keeyak tibeda?

Search

Latest ads

Reply to thread