On Tuesday, July 10, 2012 7:34:49 PM UTC+5:30, Ganesh S wrote: > > > Hi All, > > I got the below coding from some other sites.. but while executing this > macro, i got error messages and i can't solve this coding issue. Please > help me to get resolve or any new coding to split tif images thru excel vba > macro. > > "************************* > > Option Explicit > > Dim ImageFile As Long > Dim BitMapImage As Long > > Private Sub cmdFile_Click() > cmdSplit.Enabled = False > > ' create a open dialog so that you can select > ' the multipage tiff to split > CommonDialog.InitDir = App.Path > CommonDialog.DialogTitle = "Select Multi Page TIFF" > CommonDialog.DefaultExt = "*.TIF" > CommonDialog.Filter = "TIF Files|*.TIF|TIFF Files|*.TIFF" > CommonDialog.ShowOpen > > If (Len(CommonDialog.Filename) > 0) Then > > ' apply the selected image to the Kodak > ' thumbnail control to display icons of the > ' different pages > imgThumb.Image = CommonDialog.Filename > imgThumb.Refresh > > ' use the FreeImage DLL to open the multipage > ' TIFF file, and use the GetPageCount function > ' to determine if there are multiple pages to > ' process > > ImageFile = FreeImage_OpenMultiBitmap(FIF_TIFF, _ > CommonDialog.Filename, False, True) > > If (FreeImage_GetPageCount(ImageFile) > 1) Then > cmdSplit.Enabled = True > End If > > ' update caption bar with filename + page count > Caption = CommonDialog.Filename & " " & _ > FreeImage_GetPageCount(ImageFile) & " page(s)" > > ' close the multi-page TIFF file > Call FreeImage_CloseMultiBitmap(ImageFile) > End If > End Sub > > > Private Sub cmdSplit_Click() > Dim pages As Integer > Dim i As Integer > > ' use the FreeImage DLL to open the multipage > ' TIFF file, and use the GetPageCount function > ' to determine if there are multiple pages to process > ImageFile = FreeImage_OpenMultiBitmap(FIF_TIFF, _ > CommonDialog.Filename, False, True) > > pages = FreeImage_GetPageCount(ImageFile) > > i = 0 > Do While i <= (pages - 1) > ' use the lock page function to copy that > ' page into a new variable BitMapImage > BitMapImage = FreeImage_LockPage(ImageFile, i) > > ' save that page out to a new filename > Call FreeImage_Save(FIF_TIFF, BitMapImage, _ > App.Path & "\page" & i + 1 & ".tif") > > ' unlock the page > Call FreeImage_UnlockPage(ImageFile, i, False) > > i = i + 1 > Loop > > ' close the multi-page TIFF file > Call FreeImage_CloseMultiBitmap(ImageFile) > > ' feedback to user that process is complete > MsgBox pages & " pages, split from " & _ > CommonDialog.Filename, vbInformation, "Complete" > End Sub > > ***************************** > > I will expect your views and suggestion to get solution for this coding. > Please let me know if you have any clairifications. > > Thanks & Regards, > Ganesh
-- FORUM RULES (986+ members already BANNED for violation) 1) Use concise, accurate thread titles. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get quick attention or may not be answered. 2) Don't post a question in the thread of another member. 3) Don't post questions regarding breaking or bypassing any security measure. 4) Acknowledge the responses you receive, good or bad. 5) Cross-promotion of, or links to, forums competitive to this forum in signatures are prohibited. NOTE : Don't ever post personal or confidential data in a workbook. Forum owners and members are not responsible for any loss. ------------------------------------------------------------------------------------------------------ To post to this group, send email to excel-macros@googlegroups.com To unsubscribe, send a blank email to excel-macros+unsubscr...@googlegroups.com
