How to List All Files in a Folder and Create Hyperlinks to Each File

How to List All Files in a Folder and Create Hyperlinks to Each File



Below VBA Code:-

Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer


Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("C:\NitinVbaApp\Images\")
i = 1

For Each objFile In objFolder.Files
    'select cell
    Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
    'create hyperlink in selected cell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        objFile.Path, _
        TextToDisplay:=objFile.Name
    i = i + 1
Next objFile

End Sub

Read More

How to Delete all Shape image in Excel sheet

How to Delete all Shape image in Excel sheet


----------------------------------------------------
Sub Delshape()

Dim shape As Excel.shape

For Each shape In ActiveSheet.Shapes

    Select Case shape.Type
        Case msoPicture, msoMedia, msoShapeTypeMixed, msoOLEControlObject, msoAutoShape
            shape.Delete
        Case Else
            'Do nothing
    End Select
Next

End Sub
----------------------------------------------------------

Read More

How to Add slide vba powerpoint | How to Delete All Slide Power point

How to Add slide vba powerpoint
Below code:-
---------------------------------------------------------------------------
Sub addppt()
Dim objPresentaion As Presentation
Set objPresentaion = ActivePresentation

Call objPresentaion.Slides.Add(1, PpSlideLayout.ppLayoutBlank)
End Sub

---------------------------------------------------------------

How to Delete All Slide Power point
Below code:-
------------------------------------------------
Sub SlideMasterCleanup()

Dim i As Integer

Dim objPresentaion As Presentation
Set objPresentaion = ActivePresentation

For i = 1 To objPresentaion.Slides.Count

        objPresentaion.Slides.Item(1).Delete
        Next i
       

End Sub

------------------------------------------------------------

Read More

Powerpoint slide with excel vba code

Powerpoint slide with excel vba code

below click download file click link
https://drive.google.com/open?id=1Iglclf_H-xGuzbhQDssdZ86IkVa0mz_G

Please paste code in excel vba code moudle .
please add shape in excel sheet.
below copy code
---------------------------------------------
Sub expshape()

Dim myppt As PowerPoint.Application
Set myppt = New PowerPoint.Application
myppt.Visible = msoCTrue

Dim mypres As PowerPoint.Presentation
Set mypres = myppt.Presentations.Add
Dim myslide As PowerPoint.Slide
Set myslide = mypres.Slides.Add(1, ppLayoutBlank)
Dim myshape As Shape

For Each myshape In ActiveSheet.Shapes

'MsgBox myshape.Name
myshape.Copy
myslide.Shapes.PasteSpecial ppPasteBitmap
myslide.Shapes(1).Width = 500
myslide.Shapes(1).Left = 100
myslide.Shapes(1).Top = 10
Set myslide = mypres.Slides.Add(mypres.Slides.Count + 1, ppLayoutBlank)
Next
End Sub

================================

Read More

How to use Triple Loop VBA Excel

How to use Triple Loop VBA Excel

Example:-1
----------------------------------------------------
Sub myTripleLoop()
Dim c As Integer, i As Integer, j As Integer

For c = 1 To 3
    For i = 1 To 6
        For j = 1 To 2
            Worksheets(c).Cells(i, j).Value = 1700
        Next j
    Next i
Next c
End Sub
-------------------------------------------------------

Read More

How to use Double Loop VBA Excel

How to use Double Loop VBA Excel

Example:-
---------------------------------------------------
Sub myDoubleLoop()
Dim i As Integer, j As Integer

For i = 1 To 6
    For j = 1 To 3
        Cells(i, j).Value = 100
    Next j
Next i
End Sub

---------------------------------------------------------

Read More

For Loop Example VBA Excel

For Loop Example VBA Excel
 Example 1:-

Sub myforloop()
Dim i As Integer
Dim inp As Integer
Dim Disp As Integer
Disp = InputBox("Please Enter Display Number")
inp = InputBox("Please entry number for looping")
For i = 1 To inp
    Cells(i, 1).Value = Disp
Next i
End Sub

Read More

List of Folders In Directory VBA Excel Code

List of Folders In Directory VBA Excel Code

Below copy code and Paste Module 
-----------------------------------------------------
Sub ListFoldersInDirectory()

    Dim objFSO As Object
    Dim objFolders As Object
    Dim objFolder As Object
    Dim strDirectory As String
    Dim arrFolders() As String
    Dim FolderCount As Long
    Dim FolderIndex As Long


    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Select Folder"
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        End If
        strDirectory = .SelectedItems(1)
    End With
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolders = objFSO.GetFolder(strDirectory).SubFolders
   
    FolderCount = objFolders.Count
   
    If FolderCount > 0 Then
        ReDim arrFolders(1 To FolderCount)
        FolderIndex = 0
        For Each objFolder In objFolders
            FolderIndex = FolderIndex + 1
            arrFolders(FolderIndex) = objFolder.Name
        Next objFolder
       ' Worksheets.Add
        Range("A1").Resize(FolderCount).Value = Application.Transpose(arrFolders)
    Else
        MsgBox "No folders found!", vbExclamation
    End If
   
    Set objFSO = Nothing
    Set objFolders = Nothing
    Set objFolder = Nothing
   
End Sub
------------------------------------------------------

Read More

On Error Resume Next And On Error GoTo Example of Excel VBA

On Error Resume Next And On Error GoTo Example of Excel VBA

below click for download file
https://drive.google.com/open?id=1HpUj-gBSTERFIj6tdV8FQpIrx6bmqJ_h
Below Example vba code

---------------------------------------
Sub onerrohandlingerror()
Dim rank As Integer
rank = InputBox("Enter Rank no")
On Error Resume Next
MsgBox Columns(1).Find(What:=rank).Offset(0, 1).Value

End Sub

--------------------------------------------------------
Sub onerrgoto()
Dim rank As Integer
rank = InputBox("Enter Rank no")
On Error GoTo myerrormsg
MsgBox Columns(1).Find(What:=rank).Offset(0, 1).Value

Exit Sub
myerrormsg:

MsgBox "rank not find in database"
Exit Sub

End Sub '

Read More

How to Extract file name from folder excel vba

How to Extract file name from folder excel vba

Please click for download file
https://drive.google.com/open?id=1HpUj-gBSTERFIj6tdV8FQpIrx6bmqJ_h




Below VBA code
-------------------------------------------------------
Sub myextrfile()
Dim n As Integer
Dim i As Integer
Dim xx As String

        With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "PLease Select file"
        .Show
       
        n = .SelectedItems.Count
        For i = 1 To n
        xx = .SelectedItems(i)
        Range("A" & i).Value = myExtractfilename(xx)
        Next i
        End With
        End Sub
       


Function myExtractfilename(xx As Variant) As String
Dim totlen As Integer
totlen = Len(xx)
nm = WorksheetFunction.Substitute(xx, "\", "")
newlen = Len(nm)
diff = totlen - newlen
newtext = WorksheetFunction.Substitute(xx, "\", "@", diff)
sp = WorksheetFunction.Search("@", newtext)
newdiff = totlen - sp
myExtractfilename = Right(xx, newdiff)
End Function
------------------------------------------------------------------------------

Read More

How to USerform - only Userform Visible not Excel Sheet

How to USerform - only Userform Visible not Excel Sheet


Please click here for download File vba.
https://drive.google.com/open?id=1twWXZ1JAGuF0nLQYqaToj--fsqba4nKW


Step1-

step 2:-

Step 3

below vba code 

Private Sub SubmitB_Click()
If UsernameT.Value = "NITIN" And PasswordT.Value = "PASS" Then
Unload Me
Application.Visible = True

Else

MsgBox ("You are incurrect Passwor and user id")

End If


End Sub


---------------------------------------------------------------------------------------------



Private Sub UserForm_Activate()
Application.Visible = False

End Sub


--------------------------------------------------------------------------------
Private Sub Workbook_Open()
UserForm1.Show
End Sub

---------------------------------------------------

Read More

How to make excel VBA power point slide

How to make excel VBA power point slide




Click for Download file:-https://drive.google.com/file/d/1twWXZ1JAGuF0nLQYqaToj--fsqba4nKW/view?usp=sharing


Below copy code and paste excel vba module - 100% Working
--------------------------------------------------------------------------------------
Sub powerpointmyppt()
Dim ppapp As PowerPoint.Application
Dim pppres As PowerPoint.Presentation
Dim ppslide As PowerPoint.Slide

Set ppapp = New PowerPoint.Application
ppapp.Visible = True

ppapp.Activate

Set pppres = ppapp.Presentations.Add
Set ppslide = pppres.Slides.Add(1, ppLayoutBlank)
Sheet1.Range("A1").CurrentRegion.Copy
ppslide.Select

ppslide.Shapes.PasteSpecial (ppPasteEnhancedMetafile)
Set myshape = ppslide.Shapes(ppslide.Shapes.Count)
myshape.Left = 150
myshape.Top = 50

Application.CutCopyMode = False

End Sub

---------------------------------------------------------------------------

Read More