Hello,

I have a problem with some code I have and was hoping for some
assistance.

The code below is supose to do the following:
1. Create a dialog box in the current workbook (Centara Feasibility
Study)
2. I select the sheets I would like to export to another (new)
workbook in JPEG format by selecting the checkboxes in the dialog box.
3. Once i press OK the following is supose to happen:
A. A new workbook is created (Centara Feasibility Copy 1.xls)
B. Sheets on the original workbook are copied (if the dialog
check box for that sheet was selected) and are then pasted in the new
workbook as JPEG files.
C. Just prior to this the macro is supose to add a new worksheet
in the 'Copy 1' workbook and rename the sheet (the new name for the
sheet is supose to be the same name as the sheet where the original
was copied from).

Thats it...except for a bug I cannot for the life of me figure out
what to do.
The bug is somewhere in the selecting of the sheets to copy and the
nameing of the new worksheets.

Any help on this would be appreciated.
Thanks
Tim


Sub Export_Sheets()

Dim mypass As String

Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim CB As CheckBox
Application.ScreenUpdating = False

' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add

SheetCount = 0

' Add the checkboxes
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)
' Skip empty sheets sheets
If Application.CountA(CurrentSheet.Cells) = 0 Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).text = _
CurrentSheet.Name
If Worksheets(i).Visible < xlSheetVisible Then
PrintDlg.CheckBoxes(SheetCount).Value = True
End If
TopPos = TopPos + 13
End If
Next i

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Select sheets to export"
End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount < 0 Then
If PrintDlg.Show Then
Workbooks.Add
ChDir "C:\Documents and Settings\Em\Desktop"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\Em\Desktop\Centara
Feasibility Copy 1.xls", _
ReadOnlyRecommended:=False, CreateBackup:=False
For Each CB In PrintDlg.CheckBoxes
Worksheets(CB.Caption).Activate
If CB.Value = xlOn Then
Windows("Centara Feasibility Study
Tool.xls").Activate
Sheets(CB.SheetCount.text).Select
Range("A1:X163").Select
Range("A1:X163").Copy
Windows("Centara Feasibility Copy 1.xls").Activate
Sheets.Add
Sheets(ActiveSheet).Name =
PrintDlg.CheckBoxes(SheetCount).text
Range("A1").Select
ActiveSheet.Pictures.Paste.Select
Selection.ShapeRange.ZOrder msoSendToBack
Range("A1").Select
Application.CutCopyMode = False
Else
ActiveSheet.Visible = xlSheetVisible
End If
Next CB
End If
Else
MsgBox "All worksheets are empty."
End If

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete

' Reactivate original sheet
Cover.Activate
End Sub