Monday, June 29, 2020

Determine if an employee should appear using predetermined rules of attendance system

Option Explicit
Sub evenoddconditionalformatting()
'Dim days() As String
Sheets("Sheet1").Select
ActiveSheet.Cells.ClearFormats
'get the days in the days array
Dim selectioncells As Range
Range(Range("B1"), Range("B1").End(xlToRight)).Select

Set selectioncells = selection
 

 'MsgBox (selection.Address)
 'MsgBox (selection.Count)
 Dim arraylength As Integer


 ReDim days(selection.Count)
 'MsgBox (UBound(days))
Dim cell As Range, i As Integer
i = 1
 For Each cell In selectioncells
 days(i) = cell.Value

i = i + 1


 Next
 
 Dim names() As String
 Range("a2", Range("a2").End(xlDown)).Select
 'MsgBox (selection.Count)
 'Dim arraylength As Integer

 Set selectioncells = selection
 ReDim names(selectioncells.Count)
 'MsgBox (UBound(days))
 'Dim cell As Range, i As Integer
 
 For i = 1 To selectioncells.Count
 names(i) = selectioncells(i).Value
 
 
 
 
 Next
'
' For i = 1 To UBound(names)
'
' MsgBox (names(i))
'
' Next i
'
 Dim dict As Object 'Declare a generic Object reference
Set dict = CreateObject("Scripting.Dictionary") 'Late Binding of the Dictionary

For i = 1 To UBound(names)

Dim key, val
key = names(i): val = Application.RandBetween(0, 1)
'Add item to VBA Dictionary
If Not dict.Exists(key) Then
    dict.Add key, val
End If

Next i
'
'Debug.Print dict.Count 'Result: 1
'
For Each key In dict.Keys
   Debug.Print key
Next key
'
''Print all items
'For Each val In dict.Items
'   Debug.Print val
'Next val

Range("L2").Select
For Each key In dict.Keys
   'Debug.Print key
   ActiveCell.Value = key
   ActiveCell.Offset(0, 1).Value = dict(key)
   ActiveCell.Offset(1, 0).Select
  
  
  
Next key

Set selectioncells = Range("B2:H11")
For Each cell In selectioncells
'Debug.Print cell.End(xlToLeft).Value
'Debug.Print cell.End(xlUp).Value




Dim pos As Integer
For i = 1 To UBound(days)
If cell.End(xlUp).Value = days(i) Then
pos = i
Exit For
End If
Next i
'MsgBox (pos)
pos = pos - 1
pos = pos Mod 2
'MsgBox (pos)
Dim pos2 As Integer
For Each key In dict.Keys
   'Debug.Print key
   If cell.End(xlToLeft).Value = key Then
   pos2 = dict(key)
   Exit For
   End If
  
Next key
'MsgBox (pos2)
If pos = pos2 Then
cell.Value = "Should be present"
Else
cell.Value = "Should be absent"
End If

Next cell

ActiveSheet.Columns.AutoFit

Dim mydate As String

mydate = Format(Date, "dddd")

Range(Range("B1"), Range("B1").End(xlToRight)).Select

Set selectioncells = selection
 



 For Each cell In selectioncells
 If mydate = cell.Value Then
 
 Range(cell, cell.End(xlDown)).Select
 

 
 Exit For
 
 End If
 




 Next
Set selectioncells = selection
 

'MsgBox (selectioncells.Address)

 For Each cell In selectioncells
 If cell.Value Like "*present" Then

 cell.Interior.ColorIndex = 44
 Else
 
 





 End If
 

'MsgBox (cell.Value)


 Next

End Sub

Sunday, June 28, 2020

Delete single or multiple pages from pdf file automatically using VBA and Acrobat Pro

Option Explicit

Sub deletepagefrompdf()
Dim aapp As Acrobat.AcroApp
Dim todoc As Acrobat.AcroPDDoc

Set aapp = CreateObject("AcroExch.App")
Set todoc = CreateObject("AcroExch.PDDoc")

aapp.Show
todoc.Open ("C:\Users\allso\Desktop\excel_to_pdf\merged_firstpage.pdf")

If todoc.DeletePages(0, 1) = True Then
Debug.Print "Deleted"
Else
Debug.Print "Failed To Delete"
End If


If todoc.Save(PDSaveFull, "C:\Users\allso\Desktop\excel_to_pdf\edited_deleted_firstpage.pdf") = False Then
Debug.Print "Failed to save the file"
Else
Debug.Print "Saved"

End If

todoc.Close

aapp.Exit




Set aapp = Nothing
Set todoc = Nothing

'close the blank acrobat window


Dim sKillExcel As String

sKillExcel = "TASKKILL /F /IM Acrobat.exe"
Shell sKillExcel, vbHide


End Sub


Combine pdfs together automatically using VBA and Acrobat Pro



Option Explicit

Sub combine_pdf_files()

Dim aapp As Acrobat.AcroApp
Dim todoc As Acrobat.AcroPDDoc
Dim fromdoc As Acrobat.AcroPDDoc
Set aapp = CreateObject("AcroExch.App")
Set todoc = CreateObject("AcroExch.PDDoc")
Set fromdoc = CreateObject("AcroExch.PDDOc")
aapp.Show
todoc.Open ("C:\Users\allso\Desktop\blank_pdf.pdf")
fromdoc.Open ("C:\Users\allso\Desktop\201753431466049.pdf")
If todoc.InsertPages(-1, fromdoc, 0, fromdoc.GetNumPages(), True) = False Then
'Here by using -1 we are trying to copy the frompdf to the first
'page of topdf,if the number is 0 it will be the next page from the first,if it is 1 it will be the second page from beginning

Debug.Print "Failed to insert the page"
End If
If todoc.Save(PDSaveFull, "C:\Users\allso\Desktop\excel_to_pdf\merged_firstpage.pdf") = False Then
Debug.Print "Failed to save the file"
Else
Debug.Print "Saved"

End If

todoc.Close
fromdoc.Close
aapp.Exit




Set aapp = Nothing
Set todoc = Nothing
Set fromdoc = Nothing


'closing the blank window of Acrobat

Dim sKillExcel As String

sKillExcel = "TASKKILL /F /IM Acrobat.exe"
Shell sKillExcel, vbHide

End Sub

Saturday, June 27, 2020

Kill a running process(In my case it is acrobat) using VBA

Sub test2()
Dim sKillExcel As String

sKillExcel = "TASKKILL /F /IM Acrobat.exe"
Shell sKillExcel, vbHide

End Sub

Source:https://stackoverflow.com/questions/26303173/how-can-i-kill-task-manager-processes-through-vba-code

Friday, June 26, 2020

Automated multiple PDF files batch data entry using VBA and Acrobat Library

Option Explicit
Public Const pdf_form_file  As String = "C:\Users\allso\Desktop\New Customer Registration Form.pdf"
Sub readpdfformfield()
Sheets("PDF_Form_Fields").Select
Cells.Clear
Dim eapp As Acrobat.AcroApp
Dim av_doc As Acrobat.AcroAVDoc
Dim pdf_form As AFORMAUTLib.AFormApp
Dim pdf_form_flds As AFORMAUTLib.Fields
Dim pdf_form_fld As AFORMAUTLib.Field
Dim rng, firstcell As Range
Dim rownum, colnum As Integer
rownum = 1: colnum = 1
Set eapp = CreateObject("AcroExch.App")
Set av_doc = CreateObject("AcroExch.AVDoc")
If av_doc.Open(pdf_form_file, "") = True Then
av_doc.BringToFront
eapp.Hide
Set pdf_form = CreateObject("AFORMAUT.App")
Set pdf_form_flds = pdf_form.Fields

For Each pdf_form_fld In pdf_form_flds

With pdf_form_fld
'Debug.Print .Name & "|" & .Type & "|" & .Value
Cells(rownum, colnum) = .Name & "|" & .Type & "|" & .Value
Cells(rownum, colnum).Select
Set rng = Cells(rownum, colnum)
'MsgBox (rng.Address)
 'rng.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", TrailingMinusNumbers:=True
Set firstcell = Cells(rownum, rng.Column)
'MsgBox (firstcell.Address)
rng.TextToColumns Destination:=firstcell, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", TrailingMinusNumbers:=True

rownum = rownum + 1

End With
Next pdf_form_fld

av_doc.Close False

End If

eapp.Exit

Set av_doc = Nothing
Set eapp = Nothing

End Sub


Sub write_to_pdf_form()
Dim filenamepart As Integer
filenamepart = 1
Sheets("DataForPDF").Select
Range("A1").Select
Dim startrange As Range
Set startrange = Selection
While ActiveCell.Value <> ""

Dim pdfapp As Acrobat.AcroApp
Dim pdfdoc As Acrobat.AcroAVDoc
Dim support_doc As Acrobat.AcroPDDoc

Dim pdf_form As AFORMAUTLib.AFormApp
Dim pdf_form_flds As AFORMAUTLib.Fields

Dim givenname As AFORMAUTLib.Field
Dim familyname As AFORMAUTLib.Field
Dim address1 As AFORMAUTLib.Field
Dim phonenumber As AFORMAUTLib.Field
Dim findsource As AFORMAUTLib.Field
Dim email As AFORMAUTLib.Field
Dim willingtorecommend As AFORMAUTLib.Field
Set pdfapp = CreateObject("AcroExch.App")
Set pdfdoc = CreateObject("AcroExch.AVDoc")


If pdfdoc.Open(pdf_form_file, "") = True Then
pdfdoc.BringToFront
pdfapp.Hide
Set pdf_form = CreateObject("AFORMAUT.App")
Set pdf_form_flds = pdf_form.Fields

Set givenname = pdf_form.Fields("fullName3[first]")
Set familyname = pdf_form.Fields("fullName3[last]")
Set address1 = pdf_form.Fields("address4[addr_line1]")
Set phonenumber = pdf_form.Fields("phoneNumber5[full]")
Set email = pdf_form.Fields("email6")
Set findsource = pdf_form.Fields("howDid8")
Set willingtorecommend = pdf_form.Fields("willYou[0]")

Sheets("DataForPDF").Select
Cells(filenamepart, 1).Select


givenname.Value = ActiveCell.Value

familyname.Value = ActiveCell.Offset(0, 1).Value
address1.Value = ActiveCell.Offset(0, 2).Value
phonenumber.Value = ActiveCell.Offset(0, 3).Value
email.Value = ActiveCell.Offset(0, 4).Value
findsource.Value = ActiveCell.Offset(0, 5).Value
willingtorecommend.Value = ActiveCell.Offset(0, 6).Value

Set support_doc = pdfdoc.GetPDDoc

Dim path As String
path = "C:\Users\allso\Desktop\excel_to_pdf\output_" & filenamepart & ".pdf"
filenamepart = filenamepart + 1
'MsgBox (path)
If support_doc.Save(PDSaveFull, path) Then
Debug.Print "Saved"
Else
Debug.Print "Failed to save"


End If

pdfdoc.Close True
support_doc.Close
pdfapp.Exit

Set givenname = Nothing
Set familyname = Nothing
Set address1 = Nothing
Set phonenumber = Nothing
Set email = Nothing
Set findsource = Nothing
Set willingtorecommend = Nothing
Set pdfdoc = Nothing
Set support_doc = Nothing
End If

Wend

End Sub



Get the first cell of a range in VBA

Sub test()
Dim rng As Range
Set rng = Cells(1, 1)
Dim rng2 As Range

'MsgBox (Range(Cells(1, rng.Column)))
Set rng2 = Cells(1, rng.Column)
MsgBox (rng2.Address)
End Sub

Read Form fields from pdf using acrobat pro library and write them in excel and perform a texttocolumns operation for every time the loop rotates using VBA

I already add a reference of adobe acrobat 10.0 type library,I also need to add AForm Aut 1.0 Type Library reference to my project

Option Explicit
Public Const pdf_form_file  As String = "C:\Users\allso\Desktop\Business Loan Application Form.pdf"
Sub readpdfformfield()
Sheets("PDF_Form_Fields").Select
Cells.Clear
Dim eapp As Acrobat.AcroApp
Dim av_doc As Acrobat.AcroAVDoc
Dim pdf_form As AFORMAUTLib.AFormApp
Dim pdf_form_flds As AFORMAUTLib.Fields
Dim pdf_form_fld As AFORMAUTLib.Field
Dim rng, firstcell As Range
Dim rownum, colnum As Integer
rownum = 1: colnum = 1
Set eapp = CreateObject("AcroExch.App")
Set av_doc = CreateObject("AcroExch.AVDoc")
If av_doc.Open(pdf_form_file, "") = True Then
av_doc.BringToFront
eapp.Hide
Set pdf_form = CreateObject("AFORMAUT.App")
Set pdf_form_flds = pdf_form.Fields

For Each pdf_form_fld In pdf_form_flds

With pdf_form_fld
'Debug.Print .Name & "|" & .Type & "|" & .Value
Cells(rownum, colnum) = .Name & "|" & .Type & "|" & .Value
Cells(rownum, colnum).Select
Set rng = Cells(rownum, colnum)
'MsgBox (rng.Address)
 'rng.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", TrailingMinusNumbers:=True
Set firstcell = Cells(rownum, rng.Column)
'MsgBox (firstcell.Address)
rng.TextToColumns Destination:=firstcell, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", TrailingMinusNumbers:=True

rownum = rownum + 1

End With
Next pdf_form_fld

av_doc.Close False

End If

eapp.Exit

Set av_doc = Nothing
Set eapp = Nothing

End Sub

Performing Text to Column automatically using VBA

I have a string variable containing a string which contains lots of "|" character,I need to do a text to column using VBA,My string variable in in cell A1

Sub Macro1()
'
' Macro1 Macro
'

'
Dim rng As Range
Set rng = Range("A1")


    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", TrailingMinusNumbers:=True
       
'        Selection.TextToColumns _
'      Destination:=Range("A2"), _
'      DataType:=xlDelimited, _
'      TextQualifier:=xlDoubleQuote, _
'      ConsecutiveDelimiter:=False, _
'      Tab:=True, _
'      Semicolon:=False, _
'      Comma:=False, _
'      Space:=False, _
'      Other:=True, _
'      OtherChar:="-"
End Sub

Read Table from pdf using acrobat pro and vba

Option Explicit
Public Const pdf_file  As String = "C:\Users\allso\Desktop\table.pdf"



Sub pdftoexcel()
Dim eapp As Acrobat.AcroApp
Dim av_doc As CAcroAVDoc
Dim pdf_doc As CAcroPDDoc
Dim sel_text As CAcroPDTextSelect
Dim i, j As Long
Dim pagenumber, pagecontent, content
Dim data_print As Boolean
Dim cnt As Long
Dim currow As Long
currow = 1
Sheets("PDF_To_Excel").Select
Cells.Clear


Set eapp = CreateObject("AcroExch.App")
Set av_doc = CreateObject("AcroExch.AVDoc")
If av_doc.Open(pdf_file, vbNull) <> True Then Exit Sub
While av_doc Is Nothing
Set av_doc = eapp.GetActiveDoc
Wend
Set pdf_doc = av_doc.GetPDDoc
For i = 0 To pdf_doc.GetNumPages - 1
Set pagenumber = pdf_doc.AcquirePage(i)
Set pagecontent = CreateObject("AcroExch.HiliteList")
On Error Resume Next
If pagecontent.Add(0, 9000) <> True Then Exit Sub
Set sel_text = pagenumber.CreatePageHilite(pagecontent)
On Error GoTo 0

For j = 0 To sel_text.GetNumText - 1
'Debug.Print sel_text.GetText(j)
'content = sel_text.GetNumText(j)
content = sel_text.GetText(j)
If content Like "*Disability*" Then
data_print = True
ElseIf content Like "*Postal*" Then
data_print = False
Exit For
End If

If data_print = True Then
cnt = cnt + 1
Cells(currow, cnt) = Application.WorksheetFunction.Clean(Trim(content))
'Debug.Print content
End If

If cnt = 6 Then
cnt = 0
currow = currow + 1
End If

'Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = sel_text.GetText(j)
Next j

Next i

av_doc.Close False
eapp.Exit
Set sel_text = Nothing
Set pagenumber = Nothing
Set eapp = Nothing
Set av_doc = Nothing
Set pdf_doc = Nothing
End Sub


Wednesday, June 24, 2020

Get text data from pdf to excel range using acrobat library in VBA


First we need to add the acrobat reference and see if Adobe Acrobat 10.0 Type Library is enabled

Option Explicit
Public Const pdf_file  As String = "C:\Users\allso\Desktop\Business Loan Application Form.pdf"



Sub pdftoexcel()
Dim eapp As Acrobat.AcroApp
Dim av_doc As CAcroAVDoc
Dim pdf_doc As CAcroPDDoc
Dim sel_text As CAcroPDTextSelect
Dim i, j As Long
Dim pagenumber, pagecontent, content
Set eapp = CreateObject("AcroExch.App")
Set av_doc = CreateObject("AcroExch.AVDoc")
If av_doc.Open(pdf_file, vbNull) <> True Then Exit Sub
While av_doc Is Nothing
Set av_doc = eapp.GetActiveDoc
Wend
Set pdf_doc = av_doc.GetPDDoc
For i = 0 To pdf_doc.GetNumPages - 1
Set pagenumber = pdf_doc.AcquirePage(i)
Set pagecontent = CreateObject("AcroExch.HiliteList")
On Error Resume Next
If pagecontent.Add(0, 9000) <> True Then Exit Sub
Set sel_text = pagenumber.CreatePageHilite(pagecontent)
On Error GoTo 0

For j = 0 To sel_text.GetNumText - 1
'Debug.Print sel_text.GetText(j)
Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = sel_text.GetText(j)
Next j

Next i

av_doc.Close False
eapp.Exit
Set sel_text = Nothing
Set pagenumber = Nothing
Set eapp = Nothing
Set av_doc = Nothing
Set pdf_doc = Nothing
End Sub

Sunday, June 21, 2020

Check if a folder exists in a path ,if not create it,then save all the sheets in a workbook in that folder with a name containing workbookname and current time in "yyyymmdd\_hhmmss" format

Option Explicit
Function Path_Exists(Path As String) As String

'Dim Path As String
Dim Folder As String
Dim Answer As VbMsgBoxResult

   ' Path = "C:\Users\allso\Desktop\excel_to_pdf"

    Folder = dir(Path, vbDirectory)
' MsgBox (Path)
' MsgBox (Folder)
    If Folder = vbNullString Then

        Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")

        Select Case Answer
            Case vbYes
                VBA.FileSystem.MkDir (Path)
            Case Else
                Exit Function
        End Select

    Else

       ' MsgBox "Folder exists."

    End If
   Path_Exists = Path
End Function

Sub vba_excel_to_pdf()
'Path_Exists ("C:\Users\allso\Desktop\excel_to_pdf")
Dim output_file As String, ws_count, I As Integer
'output_file = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".pdf"
'MsgBox (output_file)
'Set the location where the pdfs will be saved

'Dim pdffolder As FileDialog
'
'
'
'
'Set pdffolder = Application.FileDialog(msoFileDialogFolderPicker)
'pdffolder.AllowMultiSelect = False
'pdffolder.Show
'
'
  
Dim dir As String
'dir = pdffolder.SelectedItems(1)
dir = Path_Exists("C:\Users\allso\Desktop\excel_to_pdf")
'MsgBox (dir)
Dim strtime As String


' ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=dir & "\" & customer_code & ".pdf", openafterpublish:=False
 ' Set WS_Count equal to the number of worksheets in the active
        
         ws_count = ActiveWorkbook.Worksheets.Count

         ' Begin the loop.
         For I = 1 To ws_count

            ' Insert your code here.
            ' The following line shows how to reference a sheet within
            ' the loop by displaying the worksheet name in a dialog box.
           ' MsgBox ActiveWorkbook.Worksheets(I).Name
          
        strtime = Format(Now(), "yyyymmdd\_hhmmss")
       ' MsgBox (strtime)
           output_file = dir & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & "." & ActiveWorkbook.Worksheets(I).Name & "." & strtime & ".pdf"
           'MsgBox (output_file)

           ActiveWorkbook.Worksheets(I).ExportAsFixedFormat xlTypePDF, output_file, xlQualityStandard, openafterpublish:=False
           'ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=output_file, openafterpublish:=False

         Next I

End Sub


Source:https://www.contextures.com/excelvbapdf.html

check if a folder exists in a path and if not create the folder in that path on user prompt using vba

Sub Path_Exists()

Dim Path As String
Dim Folder As String
Dim Answer As VbMsgBoxResult

    Path = "C:\Users\allso\Desktop\excel_to_pdf"

    Folder = dir(Path, vbDirectory)
 
    If Folder = vbNullString Then

        Answer = MsgBox("Path does not exist. Would you like to create it?", vbYesNo, "Create Path?")

        Select Case Answer
            Case vbYes
                VBA.FileSystem.MkDir (Path)
            Case Else
                Exit Sub
        End Select

    Else

        MsgBox "Folder exists."

    End If

End Sub

Friday, June 19, 2020

Create a clustered bar chart using vba



This is my Source Data



I need to create a clustered bar chart using this data as source

to do this

Option Explicit
Sub chartcreationpart1()


'Declare some variables
Dim Chrt As ChartObject
Dim DataRng As Range

'Add a chart object, this would be an empty shell
Set Chrt = ActiveSheet.ChartObjects.Add(Left:=400, _
                                        Width:=800, _
                                        Height:=800, _
                                        Top:=50)

    'Define the data to be used in the chart.
    Set DataRng = Range("A1").CurrentRegion
    Chrt.Chart.SetSourceData Source:=DataRng
    
    'Define the type of chart it is.
    Chrt.Chart.ChartType = xlBarClustered

'Lets add a title
Chrt.Chart.HasTitle = True

'Create a reference to that title
Dim ChrtTitle As ChartTitle
Set ChrtTitle = Chrt.Chart.ChartTitle
    
    'Do some formatting with the title.
    ChrtTitle.Text = "Performance"
    ChrtTitle.Shadow = False
    ChrtTitle.Characters.Font.Bold = False
    ChrtTitle.Characters.Font.Name = "Arial Nova"

'Add a legend to the chart
Chrt.Chart.HasLegend = True

'Create a reference to that legend
Dim ChrtLeg As Legend
Set ChrtLeg = Chrt.Chart.Legend

    'Do some formatting
    ChrtLeg.Position = xlLegendPositionTop
    ChrtLeg.Height = 20

'Remove the gridlines
Chrt.Chart.SetElement msoElementPrimaryCategoryGridLinesNone
Chrt.Chart.SetElement msoElementPrimaryValueGridLinesNone

'Make sure the chart has some axes, it's usually true by default
Chrt.Chart.HasAxis(xlCategory, xlPrimary) = True
Chrt.Chart.HasAxis(xlValue, xlPrimary) = True

'Make sure each axis has a title
Chrt.Chart.Axes(xlValue, xlPrimary).HasTitle = True
Chrt.Chart.Axes(xlCategory, xlPrimary).HasTitle = True

'Take the newly created title and create a reference to it.
Dim AxisTitle As AxisTitle
Set AxisTitle = Chrt.Chart.Axes(xlCategory, xlPrimary).AxisTitle

    'Do some formatting.
    AxisTitle.Text = "Years"
    AxisTitle.HorizontalAlignment = xlCenter
    AxisTitle.Characters.Font.Color = vbRed
    
Set AxisTitle = Chrt.Chart.Axes(xlValue, xlPrimary).AxisTitle

    'Do some formatting.
    AxisTitle.Text = "Profit/Cost/Sales"
    AxisTitle.HorizontalAlignment = xlCenter
    AxisTitle.Characters.Font.Color = vbRed
    
    
End Sub



The output chart is



Thursday, June 18, 2020

Conditional Formatting periodically using VBA macro


Sub conditionsuperfinal()
Sheets("conditionalformattingvba").Select
Dim dict As Object 'Declare a generic Object reference
Set dict = CreateObject("Scripting.Dictionary") 'Late Binding of the Dictionary
Range("T2").Select
While ActiveCell.Value <> ""
Dim key, val
key = ActiveCell.Value: val = ActiveCell.Offset(0, 1).Address
'Add item to VBA Dictionary
If Not dict.Exists(key) Then
    dict.Add key, val
End If
ActiveCell.Offset(1, 0).Select


Wend

'Debug.Print dict.Count 'Result: 1
'
'Debug.Print dict.Exists("North")
'For Each key In dict.Keys
'   Debug.Print key
'Next key
'
''Print all items
'For Each val In dict.Items
'   Debug.Print val
'Next val


'copy format of cells where condition matches
'Dim tempaddress As String
'Range("V2").Select
'tempaddress = Selection.Address
'For Each val In dict.Items
'
'Range(val).Select
'Selection.Copy
'Range(tempaddress).PasteSpecial Paste:=xlPasteFormats
'tempaddress = ActiveCell.Offset(1, 0).Address
'
'Next val
'Application.CutCopyMode = False

Sheets("conditionalformattingvba").Select
Dim workingrange, cell As Range
Range("I2").CurrentRegion.Select
Set workingrange = Selection
Selection.ClearFormats
For Each cell In workingrange
For Each key In dict.Keys
If InStr(1, cell.Value, key, vbTextCompare) > 0 Then
Range(dict(key)).Select
Selection.Copy
cell.PasteSpecial Paste:=xlPasteFormats
Exit For

Else

cell.ClearFormats
End If
Next key
'Debug.Print cell.Address
Next cell


'Dispose of VBA Dictionary
Set dict = Nothing
Application.CutCopyMode = False



End Sub




Sub formatandclear()


Sheets("conditionalformattingvba").Select
Dim workingrange, cell As Range
Range("I2").CurrentRegion.Select
Set workingrange = Selection
'MsgBox (Selection.Rows.Count)
'MsgBox (Selection.Columns.Count)
Dim startrow, startcolumn As Integer
startrow = Range("I2").Row
'MsgBox (startrow)
startcolumn = Range("I2").Column
'MsgBox (startcolumn)
Dim signal As Boolean
signal = False
If (Cells(startrow, startcolumn).Interior.ColorIndex <> 2) And (Cells(startrow, startcolumn).Font.ColorIndex <> 1) Then
For i = 1 To Selection.Rows.Count
For j = 1 To Selection.Columns.Count



    
    Cells(i + (startrow - 1), j + (startcolumn - 1)).Interior.ColorIndex = 2
    Cells(i + (startrow - 1), j + (startcolumn - 1)).Font.ColorIndex = 1
    



Next j


Next i

Else
conditionsuperfinal
End If

End Sub

Sub start_time()
Application.OnTime Now + TimeValue("00:00:10"), "formatandclear"
End Sub

Sub end_time()
Application.OnTime Now + TimeValue("00:00:05"), "formatandclear", False
End Sub

Sub BlinkCell()

'Dim CellToBlink As Range
'Set CellToBlink = Range("H1")

Do While (True)

formatandclear
Application.Wait (Now + TimeValue("0:00:01"))

formatandclear

Application.Wait (Now + TimeValue("0:00:01"))


DoEvents

If Range("D1").Value = 1 Then Exit Do

Loop



End Sub

Tuesday, June 16, 2020

download all pictures and videos from private or public profile of instagram using instaloader and python

pip install instaloader

instaloader -l username -p password profile the.good_life_

where the.good_life_ is the profile name

it will be downloaded in the current directory where you are at in terminal in the folder having similar name as the profile name

Write in a excel cell using CSharp

Create a windows form project,add a com reference named Microsoft Excel 16.0 Object Library

Create a Class named Excel
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;
using Microsoft.Office.Interop.Excel;
using _Excel = Microsoft.Office.Interop.Excel;

namespace csharpexcelwritedata
{
    class Excel
    {

        string path = "";
        _Application excel = new _Excel.Application();
        Workbook wb;
        Worksheet ws;
        public Excel(string path, int Sheet)
        {
            this.path = path;
            wb = excel.Workbooks.Open(path);
            ws = wb.Worksheets[Sheet];

        }
        public string ReadCell(int i, int j)
        {
            i++;
            j++;
            if (ws.Cells[i, j].Value2 != null)
                return ws.Cells[i, j].value2;
            else
                return "";

        }
        public void WriteToCell(int i,int j,string s)
        {
            i++;
            j++;
            ws.Cells[i, j].Value2 = s;
        }
        public void Save()
        {
            wb.Save();

        }
        public void SaveAs(string path)
        {
            wb.SaveAs(path);
        }
        public void Close()
        {
            wb.Close();

        }
    }
}


Now go to the form code

 private void Form1_Load(object sender, EventArgs e)
        {
            WriteData();
            OpenFile();
        }
        public void WriteData()
        {
            Excel excel = new Excel(@"C:\Users\allso\source\repos\chsarpexcelpart1\chsarpexcelpart1\Test.xlsx", 1);
            excel.WriteToCell(1, 1, "Hello I am writing");
            excel.Save();
            excel.SaveAs("Test2");
            excel.Close();

        }
        public void OpenFile()
        {
            Excel excel = new Excel(@"C:\Users\allso\source\repos\chsarpexcelpart1\chsarpexcelpart1\Test.xlsx", 1);
            MessageBox.Show(excel.ReadCell(1, 1));
            excel.Close();
        }

Read a cell from an excel sheet using CSharp

Create a windows form project,add a com reference named Microsoft Excel 16.0 Object Library

Create a Class named Excel

using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using System.Threading.Tasks;
using Microsoft.Office.Interop.Excel;
using _Excel = Microsoft.Office.Interop.Excel;
namespace chsarpexcelpart1
{
    class Excel
    {
        string path = "";
        _Application excel = new _Excel.Application();
        Workbook wb;
        Worksheet ws;
        public Excel(string path, int Sheet)
        {
            this.path = path;
            wb = excel.Workbooks.Open(path);
            ws = wb.Worksheets[Sheet];

        }
        public string ReadCell(int i, int j)
        {
            i++;
            j++;
            if (ws.Cells[i, j].Value2 != null)
                return ws.Cells[i, j].value2;
            else
                return "";

        }
        public void Close()
        {
            wb.Close();

        }
    }
}

Now go to the form code

private void Form1_Load(object sender, EventArgs e)
        {
            OpenFile();
        }
        public void OpenFile()
        {
            Excel excel = new Excel(@"C:\Users\allso\source\repos\chsarpexcelpart1\chsarpexcelpart1\Test.xlsx", 1);
            MessageBox.Show(excel.ReadCell(0, 0));
excel.Close();
        }


Friday, June 12, 2020

Download playlist with default subtitle using youtube-dl

C:\Windows\system32>youtube-dl --no-check-certificate -cio "C:/Users/allso/Desktop/python_tutorials/%(title)s.%(ext)s" --playlist-start 1 --playlist-end 22 -f best --write-auto-sub https://www.youtube.com/playlist?list=PL998lXKj66MqZ2XoXPelpO9tcgApOzUIE