Hi folks,
I will explain below one of the most common practice used in HR – human resource department e.g. Increment Letters Preparation, please follow the all steps. I will refer here following steps and topics:
- A Excel sheet with 5000 employee’s
- A word file which Increment letter template
- Mail merge Process
- MS word VBA code to generate PDF files from word
- MS word VBA code to hide zero value from increment letter for any allowance
- MS word VBA code to change authorize signatory’s scan signature as per manager name.
- Excel VBA Code to set individual password in employee’s separates increment letter ( Make sure this will work only if you are using office 32 bit only). Use info excel formula to get to know office version e.g.: =INFO(“OSVERSION”)
VBA Code for PDF generating from MS word file using mail merge
Sub Pdf_files_from_word()
'This code create by Ajit Yadav @99Excel.com
Dim fs, DocName, PDFPath, Folderpath, From, Till, Message
Folderpath = ActiveDocument.Path & "\" & "PDF Letters"
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FolderExists(Folderpath) = False Then
fs.createfolder (Folderpath)
Else
End If
From = 1 'Change From value
Till = 10 'Change Till value
Message = (Till - From) + 1
While From <= Till
ActiveDocument.MailMerge.DataSource.ActiveRecord = From
DocName = ActiveDocument.Fields(4).Result
PDFPath = Folderpath & "\" & DocName & ".pdf"
Call HideBlankCells
Call Signature_Ins
ActiveDocument.ExportAsFixedFormat OutputFileName:=PDFPath, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, Item:=wdExportDocumentContent, IncludeDocProps:=True
Call UnHideBlankCells
From = From + 1
Wend
MsgBox "Done"
End Sub
Sub HideBlankCells()
Dim TableNo, ColumnNo, RowNo, I, GetValues
TableNo = 1
ColumnNo = 2
RowNo = ActiveDocument.Tables(TableNo).Rows.Count
For I = 2 To (RowNo - 2)
GetValues = CleanString(Trim(ActiveDocument.Tables(TableNo).Cell(I, ColumnNo).Range.Text))
ActiveDocument.Tables(TableNo).Cell(I, ColumnNo).Range.Select
If GetValues = 0 Or GetValues = "" Or GetValues = "0" Or GetValues = " " Or GetValues = "" Then
ActiveDocument.Tables(TableNo).Rows(I).Select
Selection.Rows.HeightRule = wdRowHeightExactly
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Rows.Height = CentimetersToPoints(0.001)
Else: End If
Next I
End Sub
Sub UnHideBlankCells()
Dim TableNo, ColumnNo, RowHigh, RowNo
TableNo = 1
ColumnNo = 1
RowHeightV = 0.8
RowNo = ActiveDocument.Tables(TableNo).Rows.Count
ActiveDocument.Tables(TableNo).Select
Selection.Cells.VerticalAlignment = wdCellAlignVerticalCenter
Selection.Rows.HeightRule = wdRowHeightExactly
Selection.Rows.Height = CentimetersToPoints(RowHeightV)
For I = 2 To (RowNo - 1)
ActiveDocument.Tables(TableNo).Rows(I).Select
Selection.Rows.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
Next I
End Sub
Function Signature_Ins()
If ActiveDocument.Fields(17).Result = "Ankita Joshi" Then
ActiveDocument.Shapes("Rectangle 1").Select
Selection.ShapeRange.Fill.UserPicture (ActiveDocument.Path & "\" & "Sign" & "\" & "Signature_Ankita Joshi.jpg")
ElseIf ActiveDocument.Fields(17).Result = "Vikas Maurya" Then
ActiveDocument.Shapes("Rectangle 1").Select
Selection.ShapeRange.Fill.UserPicture (ActiveDocument.Path & "\" & "Sign" & "\" & "Signature_Vikas Maurya.jpg")
Else
ActiveDocument.Shapes("Rectangle 1").Select
Selection.ShapeRange.Fill.UserPicture (ActiveDocument.Path & "\" & "Sign" & "\" & "Blank.jpg")
End If
End Function