Sub Create_New_Year_Poster()
Application.DisplayAlerts = False

'Define variable for this workbook
Dim InputWkb As Workbook
Set InputWkb = ActiveWorkbook

'Define new workbook to Create poster
Dim WKB As Workbook
Dim PosterSh As Worksheet
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Set WKB = ActiveWorkbook
Set PosterSh = WKB.Sheets("Sheet1")

'Declare variable to save the Cover photo path
Dim Filename As String
Filename = Application.GetOpenFilename

'Declare variables for picture name and picture
Dim PictureName As String
Dim Pic As Picture

'Insert the picture in activesheet
Set Pic = ActiveSheet.Pictures.Insert(Filename)
Pic.Name = "New Year"

'Defind the picture measurements
Pic.ShapeRange.LockAspectRatio = msoFalse
Pic.Height = 600
Pic.Width = 625
Pic.Left = 49
Pic.Top = 15

Dim Heigh As Integer
Heigh = Pic.Height

Dim FLogo As String
FLogo = Application.GetOpenFilename

Dim Pid As Picture
Set Pid = ActiveSheet.Pictures.Insert(FLogo)
Pid.ShapeRange.LockAspectRatio = msoFalse

'If the Logo name consits of COLORFILTER
If InStr(FLogo, "ColorFilter") > 0 Then
Pid.Height = 650
Pid.Width = 625
Pid.Left = 49
Pid.Top = 0
Else: 'If the Logo name doesn't consists of COLORFILTER
Pid.Height = 220
Pid.Width = 650
Pid.Left = 30
Pid.Top = Heigh - 200
End If
'Create chart object
Dim CH As ChartObject
'copy the picture and paste on chart object
With PosterSh.Range("B2:N41")
.CopyPicture xlScreen, xlBitmap
Set CH = PosterSh.ChartObjects.Add( _
Left:=.Left, _
Top:=.Top, _
Width:=.Width, _
Height:=.Height)
With CH
.Name = "Abcd"
.Activate
End With
End With
ActiveChart.Paste

'Retrieve the file name using SPLIT function
postsplit = Split(Filename, "\")
Dim FileNameSTR As String
FileNameSTR = postsplit(UBound(postsplit))
PostsplitFileNameSTR = Split(FileNameSTR, ".")
FileNameSTR = PostsplitFileNameSTR(0)
ActiveSheet.Name = FileNameSTR

'Create a folder by using MKDIR function
Dim FolderName As String
FolderName = FileNameSTR & "_" & Format(Now, "YYYY_MM_DD_HH_MM_SS")
Application.Wait (Now + TimeValue("00:00:02"))
MkDir (InputWkb.Path & "\" & FolderName)
Application.Wait (Now + TimeValue("00:00:02"))
FolderName = InputWkb.Path & "\" & FolderName & "\"

'Export the chart object into the folder
CH.Chart.Export Filename:=FolderName & FileNameSTR & PosterSh.Name & " " & ".jpg", filtername:="jpg"

'Delete the chart object
ActiveSheet.ChartObjects("Abcd").Delete
Application.SheetsInNewWorkbook = 3
'Confirmation message as process completed
WKB.Close

Application.DisplayAlerts = True
MsgBox "Hi Exported the Poster"
End Sub