This is the full code i am using
Option Explicit
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1
'
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const GWL_STYLE As Long = (-16) 'Sets a new window style
Private Const WS_SYSMENU As Long = &H80000 'Windows style
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const SW_SHOWMAXIMIZED = 3
Private Sub CommandButton1_Click()
DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + _
KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + _
KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue("00:00:01")
ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, _
DisplayAsIcon:=False
ActiveSheet.Range("A1").Select
'added to force landscape
ActiveSheet.PageSetup.Orientation = xlLandscape
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False
End Sub
'Claim type
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then Worksheets("Sheet2").Range("d11").Value = "Repairs"
If CheckBox1.Value = False Then Worksheets("Sheet2").Range("d11").Value = " "
End Sub
Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then Worksheets("Sheet2").Range("d12").Value = "Hire"
If CheckBox2.Value = False Then Worksheets("Sheet2").Range("d12").Value = " "
End Sub
Private Sub CheckBox3_Click()
If CheckBox3.Value = True Then Worksheets("Sheet2").Range("d13").Value = "Recovery"
If CheckBox3.Value = False Then Worksheets("Sheet2").Range("d13").Value = " "
End Sub
Private Sub CheckBox4_Click()
If CheckBox4.Value = True Then Worksheets("Sheet2").Range("d14").Value = "Driver PI"
If CheckBox4.Value = False Then Worksheets("Sheet2").Range("d14").Value = " "
End Sub
Private Sub CheckBox5_Click()
If CheckBox5.Value = True Then Worksheets("Sheet2").Range("d15").Value = "Passenger PI"
If CheckBox5.Value = False Then Worksheets("Sheet2").Range("d15").Value = " "
End Sub
'Ai CSQ
Private Sub CheckBox6_Click()
If CheckBox6.Value = True Then Worksheets("Sheet2").Range("J19").Value = "Very Satisfied"
If CheckBox6.Value = False Then Worksheets("Sheet2").Range("J19").Value = " "
End Sub
Private Sub CheckBox7_Click()
If CheckBox7.Value = True Then Worksheets("Sheet2").Range("J19").Value = "Satisfied"
If CheckBox7.Value = False Then Worksheets("Sheet2").Range("J19").Value = " "
End Sub
Private Sub CheckBox8_Click()
If CheckBox8.Value = True Then Worksheets("Sheet2").Range("J19").Value = "Average"
If CheckBox8.Value = False Then Worksheets("Sheet2").Range("J19").Value = " "
End Sub
Private Sub CheckBox9_Click()
If CheckBox9.Value = True Then Worksheets("Sheet2").Range("J19").Value = "Disatisfied"
If CheckBox9.Value = False Then Worksheets("Sheet2").Range("J19").Value = " "
End Sub
Private Sub CheckBox10_Click()
If CheckBox10.Value = True Then Worksheets("Sheet2").Range("J19").Value = "Very Disatisfied"
If CheckBox10.Value = False Then Worksheets("Sheet2").Range("J19").Value = " "
End Sub
'TCL CSQ
Private Sub CheckBox11_Click()
If CheckBox11.Value = True Then Worksheets("Sheet2").Range("J20").Value = "Very Satisfied"
If CheckBox11.Value = False Then Worksheets("Sheet2").Range("J20").Value = " "
End Sub
Private Sub CheckBox12_Click()
If CheckBox12.Value = True Then Worksheets("Sheet2").Range("J20").Value = "Satisfied"
If CheckBox12.Value = False Then Worksheets("Sheet2").Range("J20").Value = " "
End Sub
Private Sub CheckBox13_Click()
If CheckBox13.Value = True Then Worksheets("Sheet2").Range("J20").Value = "Average"
If CheckBox13.Value = False Then Worksheets("Sheet2").Range("J20").Value = " "
End Sub
Private Sub CheckBox14_Click()
If CheckBox14.Value = True Then Worksheets("Sheet2").Range("J20").Value = "Disatisfied"
If CheckBox14.Value = False Then Worksheets("Sheet2").Range("J20").Value = " "
End Sub
Private Sub CheckBox15_Click()
If CheckBox15.Value = True Then Worksheets("Sheet2").Range("J20").Value = "Very Disatisfied"
If CheckBox15.Value = False Then Worksheets("Sheet2").Range("J20").Value = " "
End Sub
'SMES CSQ
Private Sub CheckBox16_Click()
If CheckBox16.Value = True Then Worksheets("Sheet2").Range("J21").Value = "Very Satisfied"
If CheckBox16.Value = False Then Worksheets("Sheet2").Range("J21").Value = " "
End Sub
Private Sub CheckBox17_Click()
If CheckBox17.Value = True Then Worksheets("Sheet2").Range("J21").Value = "Satisfied"
If CheckBox17.Value = False Then Worksheets("Sheet2").Range("J21").Value = " "
End Sub
Private Sub CheckBox18_Click()
If CheckBox18.Value = True Then Worksheets("Sheet2").Range("J21").Value = "Average"
If CheckBox18.Value = False Then Worksheets("Sheet2").Range("J21").Value = " "
End Sub
Private Sub CheckBox19_Click()
If CheckBox19.Value = True Then Worksheets("Sheet2").Range("J21").Value = "Disatisfied"
If CheckBox19.Value = False Then Worksheets("Sheet2").Range("J21").Value = " "
End Sub
Private Sub CheckBox20_Click()
If CheckBox20.Value = True Then Worksheets("Sheet2").Range("J21").Value = "Very Disatisfied"
If CheckBox20.Value = False Then Worksheets("Sheet2").Range("J21").Value = " "
End Sub
'MTA CSQ
Private Sub CheckBox21_Click()
If CheckBox21.Value = True Then Worksheets("Sheet2").Range("J22").Value = "Very Satisfied"
If CheckBox21.Value = False Then Worksheets("Sheet2").Range("J22").Value = " "
End Sub
Private Sub CheckBox22_Click()
If CheckBox22.Value = True Then Worksheets("Sheet2").Range("J22").Value = "Satisfied"
If CheckBox22.Value = False Then Worksheets("Sheet2").Range("J22").Value = " "
End Sub
Private Sub CheckBox23_Click()
If CheckBox23.Value = True Then Worksheets("Sheet2").Range("J22").Value = "Average"
If CheckBox23.Value = False Then Worksheets("Sheet2").Range("J22").Value = " "
End Sub
Private Sub CheckBox24_Click()
If CheckBox24.Value = True Then Worksheets("Sheet2").Range("J22").Value = "Disatisfied"
If CheckBox24.Value = False Then Worksheets("Sheet2").Range("J22").Value = " "
End Sub
Private Sub CheckBox25_Click()
If CheckBox25.Value = True Then Worksheets("Sheet2").Range("J22").Value = "Very Disatisfied"
If CheckBox25.Value = False Then Worksheets("Sheet2").Range("J22").Value = " "
End Sub
Private Sub ComboBox1_Change()
End Sub
Private Sub CommandButton2_Click()
Worksheets("Sheet2").Range("d3" & lngWriteRow) = TextBox1.Value
Worksheets("Sheet2").Range("d4" & lngWriteRow) = TextBox2.Value
Worksheets("Sheet2").Range("d5" & lngWriteRow) = TextBox3.Value
Worksheets("Sheet2").Range("d6" & lngWriteRow) = TextBox4.Value
Worksheets("Sheet2").Range("d7" & lngWriteRow) = TextBox5.Value
Worksheets("Sheet2").Range("d10" & lngWriteRow) = TextBox6.Value
Worksheets("Sheet2").Range("d18" & lngWriteRow) = TextBox7.Value
Worksheets("Sheet2").Range("d19" & lngWriteRow) = TextBox8.Value
Worksheets("Sheet2").Range("d22" & lngWriteRow) = TextBox9.Value
Worksheets("Sheet2").Range("d23" & lngWriteRow) = TextBox10.Value
Worksheets("Sheet2").Range("d24" & lngWriteRow) = TextBox11.Value
Worksheets("Sheet2").Range("d25" & lngWriteRow) = TextBox12.Value
Worksheets("Sheet2").Range("d26" & lngWriteRow) = TextBox13.Value
Worksheets("Sheet2").Range("d27" & lngWriteRow) = TextBox14.Value
Worksheets("Sheet2").Range("d28" & lngWriteRow) = TextBox15.Value
Worksheets("Sheet2").Range("d29" & lngWriteRow) = TextBox16.Value
Worksheets("Sheet2").Range("g3" & lngWriteRow) = TextBox17.Value
Worksheets("Sheet2").Range("g4" & lngWriteRow) = TextBox18.Value
Worksheets("Sheet2").Range("g7" & lngWriteRow) = TextBox19.Value
Worksheets("Sheet2").Range("g8" & lngWriteRow) = TextBox20.Value
Worksheets("Sheet2").Range("g11" & lngWriteRow) = TextBox21.Value
Worksheets("Sheet2").Range("g12" & lngWriteRow) = TextBox22.Value
Worksheets("Sheet2").Range("g15" & lngWriteRow) = TextBox23.Value
Worksheets("Sheet2").Range("g16" & lngWriteRow) = TextBox24.Value
Worksheets("Sheet2").Range("g19" & lngWriteRow) = TextBox25.Value
Worksheets("Sheet2").Range("g20" & lngWriteRow) = TextBox26.Value
Worksheets("Sheet2").Range("g21" & lngWriteRow) = TextBox27.Value
Worksheets("Sheet2").Range("g22" & lngWriteRow) = TextBox28.Value
Worksheets("Sheet2").Range("g23" & lngWriteRow) = TextBox29.Value
Worksheets("Sheet2").Range("g24" & lngWriteRow) = TextBox30.Value
Worksheets("Sheet2").Range("g25" & lngWriteRow) = TextBox31.Value
Worksheets("Sheet2").Range("g26" & lngWriteRow) = TextBox32.Value
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String
ChDir "S:\1SoterPS\Claims checklist"
Application.ScreenUpdating = False ' Prevents screen refreshing.
CurrentFile = ThisWorkbook.FullName
NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _
"Excel Files 2007 (*.xlsx), *.xlsx," & _
"All files (*.*), *.*"
NewFile = Application.GetSaveAsFilename( _
InitialFileName:=NewFileName, _
fileFilter:=NewFileType)
If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs Filename:=NewFile, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton3_Click()
Me.TextBox1.Value = Sheets("sheet2").Range("d3").Value
Me.TextBox2.Value = Sheets("sheet2").Range("d4").Value
Me.TextBox3.Value = Sheets("sheet2").Range("d5").Value
Me.TextBox4.Value = Sheets("sheet2").Range("d6").Value
Me.TextBox5.Value = Sheets("sheet2").Range("d7").Value
Me.TextBox6.Value = Sheets("sheet2").Range("d10").Value
Me.TextBox7.Value = Sheets("sheet2").Range("d18").Value
Me.TextBox8.Value = Sheets("sheet2").Range("d19").Value
Me.TextBox9.Value = Sheets("sheet2").Range("d22").Value
Me.TextBox10.Value = Sheets("sheet2").Range("d23").Value
Me.TextBox11.Value = Sheets("sheet2").Range("d24").Value
Me.TextBox12.Value = Sheets("sheet2").Range("d25").Value
Me.TextBox13.Value = Sheets("sheet2").Range("d26").Value
Me.TextBox14.Value = Sheets("sheet2").Range("d27").Value
Me.TextBox15.Value = Sheets("sheet2").Range("d28").Value
Me.TextBox16.Value = Sheets("sheet2").Range("d29").Value
Me.TextBox17.Value = Sheets("sheet2").Range("g3").Value
Me.TextBox18.Value = Sheets("sheet2").Range("g4").Value
Me.TextBox19.Value = Sheets("sheet2").Range("g7").Value
Me.TextBox20.Value = Sheets("sheet2").Range("g8").Value
Me.TextBox21.Value = Sheets("sheet2").Range("g11").Value
Me.TextBox22.Value = Sheets("sheet2").Range("g12").Value
Me.TextBox23.Value = Sheets("sheet2").Range("g15").Value
Me.TextBox24.Value = Sheets("sheet2").Range("g16").Value
Me.TextBox25.Value = Sheets("sheet2").Range("g19").Value
Me.TextBox26.Value = Sheets("sheet2").Range("g20").Value
Me.TextBox27.Value = Sheets("sheet2").Range("g21").Value
Me.TextBox28.Value = Sheets("sheet2").Range("g22").Value
Me.TextBox29.Value = Sheets("sheet2").Range("g23").Value
Me.TextBox30.Value = Sheets("sheet2").Range("g24").Value
Me.TextBox31.Value = Sheets("sheet2").Range("g25").Value
Me.TextBox32.Value = Sheets("sheet2").Range("g26").Value
Me.concerns.Value = Sheets("sheet2").Range("I3").Value
Me.Client_Comments.Value = Sheets("sheet2").Range("I25").Value
'Services
If Worksheets("Sheet2").Range("d11").Value = "Repairs" Then CheckBox1.Value = True
If Worksheets("Sheet2").Range("d12").Value = "Hire" Then CheckBox2.Value = True
If Worksheets("Sheet2").Range("d13").Value = "Recovery" Then CheckBox3.Value = True
If Worksheets("Sheet2").Range("d14").Value = "Driver PI" Then CheckBox4.Value = True
If Worksheets("Sheet2").Range("d15").Value = "Passenger PI" Then CheckBox5.Value = True
'CSQ Ai
If Worksheets("Sheet2").Range("J19").Value = "Very Satisfied" Then CheckBox6.Value = True
If Worksheets("Sheet2").Range("J19").Value = "Satisfied" Then CheckBox7.Value = True
If Worksheets("Sheet2").Range("J19").Value = "Average" Then CheckBox8.Value = True
If Worksheets("Sheet2").Range("J19").Value = "Disatisfied" Then CheckBox9.Value = True
If Worksheets("Sheet2").Range("J19").Value = "Very Disatisfied" Then CheckBox10.Value = True
'CSQ TCL
If Worksheets("Sheet2").Range("J20").Value = "Very Satisfied" Then CheckBox11.Value = True
If Worksheets("Sheet2").Range("J20").Value = "Satisfied" Then CheckBox12.Value = True
If Worksheets("Sheet2").Range("J20").Value = "Average" Then CheckBox13.Value = True
If Worksheets("Sheet2").Range("J20").Value = "Disatisfied" Then CheckBox14.Value = True
If Worksheets("Sheet2").Range("J20").Value = "Very Disatisfied" Then CheckBox15.Value = True
'CSQ SMES
If Worksheets("Sheet2").Range("J21").Value = "Very Satisfied" Then CheckBox16.Value = True
If Worksheets("Sheet2").Range("J21").Value = "Satisfied" Then CheckBox17.Value = True
If Worksheets("Sheet2").Range("J21").Value = "Average" Then CheckBox18.Value = True
If Worksheets("Sheet2").Range("J21").Value = "Disatisfied" Then CheckBox19.Value = True
If Worksheets("Sheet2").Range("J21").Value = "Very Disatisfied" Then CheckBox20.Value = True
'CSQ MTA
If Worksheets("Sheet2").Range("J22").Value = "Very Satisfied" Then CheckBox21.Value = True
If Worksheets("Sheet2").Range("J22").Value = "Satisfied" Then CheckBox22.Value = True
If Worksheets("Sheet2").Range("J22").Value = "Average" Then CheckBox23.Value = True
If Worksheets("Sheet2").Range("J22").Value = "Disatisfied" Then CheckBox24.Value = True
If Worksheets("Sheet2").Range("J22").Value = "Very Disatisfied" Then CheckBox25.Value = True
End Sub
Private Sub CommandButton4_Click()
Dim lFormHandle As Long, lStyle As Long
'===========================================
'= Originally from Dax =
'= Modified with comments by Ivan F Moala =
'= 22/07/01 =
'===========================================
'Lets find the UserForm Handle the function below retrieves the handle
'to the top-level window whose class name ("ThunderDFrame" for Excel)
'and window name (me.caption or UserformName caption) match the specified strings.
lFormHandle = FindWindow("ThunderDFrame", Me.Caption)
'The GetWindowLong function retrieves information about the specified window.
'The function also retrieves the 32-bit (long) value at the specified offset
'into the extra window memory of a window.
lStyle = GetWindowLong(lFormHandle, GWL_STYLE)
'lStyle is the New window style so lets set it up with the following
lStyle = lStyle Or WS_SYSMENU 'SystemMenu
lStyle = lStyle Or WS_MINIMIZEBOX 'With MinimizeBox
lStyle = lStyle Or WS_MAXIMIZEBOX 'and MaximizeBox
'Now lets set up our New window the SetWindowLong function changes
'the attributes of the specified window , given as lFormHandle,
'GWL_STYLE = New windows style, and our Newly defined style = lStyle
SetWindowLong lFormHandle, GWL_STYLE, (lStyle)
'Remove >'< if you want to show form Maximised
'ShowWindow lFormHandle, SW_SHOWMAXIMIZED 'Shows Form Maximized
'The DrawMenuBar function redraws the menu bar of the specified window.
'We need this as we have changed the menu bar after Windows has created it.
'All we need is the Handle.
DrawMenuBar lFormHandle
End Sub
Private Sub Concerns_change()
Worksheets("Sheet2").Range("I3") = concerns.Value
End Sub
Private Sub Client_Comments_change()
Worksheets("Sheet2").Range("I25" & lngWriteRow) = Client_Comments.Value
End Sub
Private Sub ScrollBar1_Change()
UserForm1.Caption = ScrollBar1.Value
End Sub