Convert word document to pdf using VBA

Option Explicit

Sub vba_word_to_pdf()

Dim output_file As String

output_file = ActivePresentation.Path & "\" & Left(ActivePresentation.Name, Len(ActivePresentation.Name) - 5) & ".pdf"

'MsgBox ("hello")

ActivePresentation.ExportAsFixedFormat output_file, ppFixedFormatTypePDF, ppFixedFormatIntentPrint

End Sub

Convert all slides in a powerpoint presentation to a pdf using VBA

Option Explicit

Sub vba_powerpoint_to_pdf()

Dim output_file As String

output_file = ActivePresentation.Path & "\" & Left(ActivePresentation.Name, Len(ActivePresentation.Name) - 5) & ".pdf"

'MsgBox ("hello")

ActivePresentation.ExportAsFixedFormat output_file, ppFixedFormatTypePDF, ppFixedFormatIntentPrint

End Sub

Read Pdf without Acrobat

Enable Microsoft Scripting Runtime reference

Option Explicit

Const form_filename As String = "C:\Users\allso\Desktop\New Customer Registration Form.pdf"

Sub read_pdf_form_vals()

Dim fso As New FileSystemObject

Dim tStream As TextStream

Dim vLine As String, vKey As String, fieldlist() As Variant, arrIndx As Integer

Dim i As Integer

vKey = ") Tj"

Set tStream = fso.OpenTextFile(form_filename, ForReading, False)

Do While Not tStream.AtEndOfStream

vLine = tStream.ReadLine

If InStr(vLine, vKey) > 0 Then

vLine = Replace(Right(vLine, Len(vLine) - 1), vKey, "", 1)

ReDim Preserve fieldlist(0 To arrIndx)

fieldlist(arrIndx) = vLine

Debug.Print vLine

arrIndx = arrIndx + 1

End If

'Debug.Print vLine

Loop

For i = UBound(fieldlist) To LBound(fieldlist) Step -1

Debug.Print fieldlist(i)

Next i

Set tStream = Nothing

Set fso = Nothing

End Sub

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

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