Check box and command box code

Loki · #1 08-12-2013, 04:50 AM

Hi all,

Please can someone help with some ideas on how to write a code for the following scenario. Keeping in mind that i know nothing about vba code.

I have a health and safety document which comprises of multiple pages and sections. Each project which i handle requires different sections from document. At the moment i am needing to print each section on its own. I am wanting to make a page in the front of the document which will act as a "selection page" where i can have multiple check boxes which is labled "Section 1" or "Section 2" ect ect. i want to be able to tick the boxes that i need to print and have a command button at the end of the "selection page" which will run and print the ticked check boxes.

So in a nut shell i need help with two codes..

1.) The code for the check box to select the correct sections.
2.) The code for the command button to print the selected check boxes.

Note i know how to create the check boxes and command button and i know how to get to the source page to enter a code, but that is about it.

Any help would greatly be appreciated.

Kind Regards

gmaxey · #2 08-14-2013, 06:38 AM

I would use a userform instead of a separate from page. Add the userform and add a checkbox for each page and a command button. Here is some code that should work:

Code:

Private Sub CommandButton1_Click()
Dim oCtr As Control
Dim strChecked As String
  For Each oCtr In Me.Controls
    If TypeName(oCtr) = "CheckBox" Then
      If oCtr.Value = True Then
        strChecked = strChecked & oCtr.Tag & ","
      End If
    End If
  Next
  If strChecked <> vbNullString Then
    strChecked = Left(strChecked, Len(strChecked) - 1)
    strChecked = fcnConcatenateString(strChecked)
    MsgBox strChecked
    'ActiveDocument.PrintOut Range = wdPrintRangeOfPages, Pages = strChecked
  End If
lbl_Exit:
  Exit Sub
End Sub
Private Sub UserForm_Initialize()
Dim oCtr As Control
Dim lngIndex As Long
  lngIndex = 1
  For Each oCtr In Me.Controls
    If TypeName(oCtr) = "CheckBox" Then
      oCtr.Caption = "Page " & lngIndex
      oCtr.Tag = lngIndex
      lngIndex = lngIndex + 1
    End If
  Next
lbl_Exit:
  Exit Sub
End Sub
Function fcnConcatenateString(strRawNumbers As String, Optional strEnd As String)
'Credit Macropod.
Dim arrTemp(), lngIndex_A As Long, lngIndex_B As Integer, lngCounter As Integer
  ReDim arrTemp(UBound(Split(strRawNumbers, ",")))
  For lngIndex_A = 0 To UBound(Split(strRawNumbers, ","))
    arrTemp(lngIndex_A) = Split(strRawNumbers, ",")(lngIndex_A)
  Next
  For lngIndex_A = 0 To UBound(arrTemp) - 1
    If IsNumeric(arrTemp(lngIndex_A)) Then
      lngCounter = 2
      For lngIndex_B = lngIndex_A + 2 To UBound(arrTemp)
        If CInt(arrTemp(lngIndex_A) + lngCounter) <> CInt(arrTemp(lngIndex_B)) Then Exit For
        arrTemp(lngIndex_B - 1) = ""
        lngCounter = lngCounter + 1
      Next
      lngIndex_A = lngIndex_B - 2
    End If
  Next
  strRawNumbers = Join(arrTemp, ",")
  strRawNumbers = Replace(Replace(Replace(strRawNumbers, ",,", " "), ", ", " "), " ,", " ")
  While InStr(strRawNumbers, "  ")
    strRawNumbers = Replace(strRawNumbers, "  ", " ")
  Wend
  strRawNumbers = Replace(Replace(strRawNumbers, " ", "-"), ",", ", ")
  If strEnd <> "" Then
    lngIndex_A = InStrRev(strRawNumbers, ",")
    If lngIndex_A > 0 Then
      strRawNumbers = Left(strRawNumbers, lngIndex_A - 1) & Replace(strRawNumbers, ",", " " & Trim(strEnd), lngIndex_A)
    End If
  End If
  fcnConcatenateString = strRawNumbers
lbl_Exit:
  Exit Function
End Function

Loki · #3 08-14-2013, 07:11 AM

Thanks alot Greg. I will give it a bash and revert if i pick up any problems.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
cannot check/uncheck check box but added check box	learn2office	Word	1	11-27-2012 02:02 AM
Add Command to Bar	neiljsalkind	Excel	0	02-03-2012 08:31 AM
Link word check box to access check box	Mrkieth	Word	4	01-30-2012 06:43 AM
Check Boxes and Command Buttons	Micky P	Word VBA	0	10-27-2011 01:06 AM
Add-In:How to add command right click command bar	phang	Outlook	0	01-15-2007 02:53 AM