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

Reply via email to