Create Identity card using VBA Macros

    Before executing the macro

  • Create a Folder on your desktop
  • Place the coding workbook in that folder
  • In that folder create a sub -folder and copy your required pictures\photos
  • While executing the program select the photos folder, consequently all the available picture names will upload into the listbox of Userform
  •  

  • Click on Image to watch the video
  •  

     

    Sub ExportDataIntoUserform()
    Dim FD As FileDialog
    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    FD.Show
    Dim FolderPath As String
    FolderPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
    Dim PictureName As String
    PictureName = Dir(FolderPath & "*.*")
    Do While PictureName <> ""
    UserForm1.ListBox1.AddItem PictureName
    PictureName = Dir
    Loop
    UserForm1.TextBox4.Value = FolderPath
    UserForm1.Show
    End Sub

    Sub Create_Identity_Card_Of_Student_Or_Employee()
    On Error Resume Next
    Dim SH As Worksheet
    Set SH = ActiveSheet
    ActiveWindow.DisplayGridlines = False
    SH.Pictures(SH.Range("B3").Value).Delete
    SH.Range("B2:F17").Clear

    With SH.Range("B3:F3")
    .Merge
    .Value = UserForm1.TextBox1.Value
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Font.Size = 15
    .Font.ColorIndex = 9
    .Font.Name = "Calibri"
    .Font.Bold = True
    End With

    SH.Range("B14").Value = "School Name:"
    SH.Range("D14").Value = UserForm1.TextBox2.Value
    SH.Range("B15").Value = "Section:"
    SH.Range("D15").Value = UserForm1.TextBox3.Value
    SH.Range("B16").Value = "Blood Group:"
    SH.Range("D16").Value = UserForm1.TextBox5.Value

    Dim PictureName As String
    For i = 0 To UserForm1.ListBox1.ListCount - 1
    If UserForm1.ListBox1.Selected(i) = True Then
    PictureName = UserForm1.ListBox1.List(i)
    Exit For
    End If
    Next

    Dim Pic As Picture
    '================================
    'Insert the Picture Directly by mentioning the path
    'Set Pic = SH.Pictures.Insert("D:\ARTICLES\my photo.png")
    '================================

    Set Pic = SH.Pictures.Insert(UserForm1.TextBox4.Value & PictureName)
    Pic.Left = 70
    Pic.Top = 50
    Pic.Name = UserForm1.TextBox1.Value
    Pic.ShapeRange.LockAspectRatio = msoFalse
    Pic.Height = 150
    Pic.Width = 200

    '===============================
    'To Provide Boarder to the picture
    'Pic.Border.LineStyle = xlContinuous
    'Pic.Border.Weight = xlThick
    'Pic.Border.ColorIndex = 9
    '=================================

    SH.Range("B14:D16").Select
    With Selection
    .HorizontalAlignment = xlLeft
    .Font.Size = 15
    .Font.ColorIndex = 9
    .Font.Name = "Calibri"
    .Columns(1).Font.Bold = True
    .Columns(3).Font.ColorIndex = 1
    End With

    Dim CH As ChartObject
    With Range("B3:F16")
    .BorderAround 1, xlThick, 9
    .CopyPicture xlScreen, xlBitmap
    Set CH = SH.ChartObjects.Add( _
    Left:=.Left, _
    Top:=.Top, _
    Width:=.Width, _
    Height:=.Height)
    With CH
    .Name = "Abcd"
    .Activate
    End With
    End With
    ActiveChart.Paste
    FolderPath = UserForm1.TextBox4.Value
    CH.Chart.Export FileName:=FolderPath & Left(PictureName, Len(PictureName) - 4) & " IDCard.jpg", filtername:="jpg"
    ActiveSheet.ChartObjects("Abcd").Delete
    Unload UserForm1
    End Sub

    Download The Workbook

     

  • Part I - Create Identity Card
  • Part II - Create Workbook addin and add to Ribbon
  •