Month: April 2021

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:

1. A Excel sheet with 5000 employee’s
2. A word file which Increment letter template
3. Mail merge Process
4. MS word VBA code to generate PDF files from word
5. MS word VBA code to hide zero value from increment letter for any allowance
6. MS word VBA code to change authorize signatory’s scan signature as per manager name.
7. 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