How to disable right click menu control in excel book

How to disable right click menu control in excel book

Step-1 go to excel vba editor

           go to this this workbook page

          

check below image and paste code

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

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.CommandBars("cell").Controls("copy").Enabled = True

Application.CommandBars("cell").Controls("cut").Visible = True

End Sub

Private Sub Workbook_Open()

Application.CommandBars("cell").Controls("copy").Enabled = False

Application.CommandBars("cell").Controls("cut").Visible = False

End Sub

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

Read More

How to ignore vba excel error runtime error '1004'

How to ignore vba error runtime error 1004

Question-when not select file then show below runtime error
below image

below copy code and paste modules
----------------------------------------------------------------------------------------------
Sub browsefileopen()

' step 1 below code for ignore runtime error
On Error Resume Next
'below browse file code
myfile = Application.GetOpenFilename(, , "Browse for File")

'browse filename update with file location in active sheet.
ThisWorkbook.Sheets("sheet1").Range("a2") = myfile


'select browse  file open code

Workbooks.Open myfile
' step 2 below code for ignore runtime error
On Error GoTo 0


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

Read More

How to Browse file and open select file vba code

How to Browse file and open select file vba code

Below vba code

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

Sub browsefileopen()

'below browse file code

myfile = Application.GetOpenFilename(, , "Browse for File")

'browse filename update with file location in active sheet.

ThisWorkbook.Sheets("sheet1").Range("a2") = myfile

'select browse  file open code

Workbooks.Open myfile

End Sub

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

Read More

This workbook contains links to other data sources-Excel vba code

Question-How to Disable alert box  This workbook contains links to other data sources Excel       vba code

worning altert-1




Worning Alert-2



Answer Solution-' Disaple Update link alert prompt box

Try below code:-


Application.AskToUpdateLinks = False
Application.DisplayAlerts = False


Try below code-

 Workbooks.Open Filename:=FullFileName, UpdateLinks:=0

Try below code-

Application.ScreenUpdating = False

Read More

How to Move Excel sheet Data to Other workbook

Example1:-Move Excel sheet Data to Other workbook

Copy Below Code and Paste in Module


Sub movefileotherworkbook()
Workbooks.Open Filename:="C:\NitinVbaAppAMD\nitin1.xlsx"
ActiveSheet.Range("A2:F4").Copy

Workbooks.Open Filename:="C:\NitinVbaAppAMD\nitin2.xlsx"
'eColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
'If eColumn >= 1 Then eColumn = eColumn + 1
ActiveSheet.Cells(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, Skipblanks:=False, Transpose:=True
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.CutCopyMode = False

End Sub

Note:-Green Highlight you can Update/change 
Note this code not paste nitin1 and nitin2 please paste another for run macro.

Read More

how to run Macro Excel file from vbs script.

VBS script Example.

how to run Macro Excel file from vbs script.

Step1- Open Notepad
>>paste below code>>File Save filename.vbs and run vbs file.

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

Set ObjExcel=CreateObject("Excel.Application")
objExcel.Application.Run"'C:\NitinVbaAppST\nitintest.xlsm'!Module1.msgtest"
ObjExcel.DisplayAlerts=False
ObjExcel.Application.Quit
Set ObjExcel=Nothing

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

please note

msgtest is macro function name which use in nitintest.xlsm fil

Read More

Excel sound play code:

Excel sound play code:-


Option Explicit

Private Declare Function sndPlaySound32 Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName _
As String, ByVal uFlags As Long) As Long

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cell As Range
    Dim PlaySound As Boolean

    If Target.Column = 3 Then
        For Each Cell In Target
            'If WorksheetFunction.IsNA(Cell.Value) Then
            If Cell.Value = "line" Then
                PlaySound = True
            End If
        Next

        If PlaySound Then
            Call sndPlaySound32("C:\windows\media\Line.wav", 1)
        End If



    End If
End Sub

Read More

Break Link Vba Code in excel

Below BreakLink code download-
Please Paste Code in modul


Sub BreakLinks()
Dim iii As Variant

 Dim astrLinks As Variant

    ' Define variable as an Excel link type.
    astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

    ' Break the first link in the active workbook.
    For iii = 1 To UBound(astrLinks)

   
    ActiveWorkbook.BreakLink _
        Name:=astrLinks(iii), _
        Type:=xlLinkTypeExcelLinks
Next iii
End Sub

Read More

Outlook Mail send Code

Outlook mail send code

Below code copy and paste module
click here for download file:-    Outlook send mail file
_______________________________________________

Sub Send_Mail()

Dim outlookobj As Outlook.Application
Dim mitem As Outlook.MailItem
Set outlookobj = New Outlook.Application
Set mitem = outlookobj.CreateItem(olMailItem)
With mitem

.To = "nppsnee@gmail.com"
.Subject = "this is testing"
.Body = "this is computer outlook mail"
.Display
End With

End Sub
__________________________________________________

Read More

How to create right click commnad bar in excel

Paste code in thisworkbook(vba code) in excel file

For click example file download:-  click here  Right click commandbar file download

Note after code paste file save in macro xlsm format and open again 

Copy below code
__________________________________________________________

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Contextmenu As CommandBar
Set Contextmenu = Application.CommandBars("Cell")
For Each ctrl In Contextmenu.Controls
If ctrl.Tag = "my_cell_control_tag" Then
ctrl.Delete
End If
Next ctrl
End Sub

Private Sub Workbook_Open()
Dim Contextmenu As CommandBar
Set Contextmenu = Application.CommandBars("Cell")
With Contextmenu.Controls.Add(Type:=msoControlButton, before:=1)
.OnAction = "'" & ThisWorkbook.Name & "'!hello"         ' hello is macro name
.FaceId = 351
.Caption = "hello"
.Tag = "my_cell_control_tag"
End With
End Sub
____________________________________________________________

and Create  a  hello name  macro in  module

Sub hello()
MsgBox "hello nitin world"

End Sub

Read More

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

Excel Vba Expire Date Close file code

Example Code:-(below copy and Paste)








Private Sub Workbook_Open()
Dim Edate As Date
Edate = Format("22/05/2019", "DD/MM/YYYY") ' Replace this with the date you want
If Date > Edate + 2 Then
MsgBox "This workbook is NOT Missing code  !", vbCritical

ActiveWorkbook.Close
 End If

End Sub

Read More

What is Range object | Vba Range Object Example

What is Range object | Vba Range Object Example

Example:-

Sub myrangeobj()

Range("B10").Value = "Hello Test Range Example"

End Sub

Output:-

Read More

VBA Excel Programme 1 | How to use Workbook, Worksheets, Sheet

VBA Excel Programme 1

Example 1:-

Sub vbafirst()

' workbook use for file name describe

Application.Workbooks("vbafirst").Worksheets(2).Range("A1").Value = "Sheet 2 using"

'worksheet use for sheet file name/sheet index/position

Worksheets("mysheet1").Range("a1").Value = "sheet 1 using"

'worksheet use for sheet file name/sheet index/position

Worksheets(4).Range("a1").Value = "sheet 4 index/position using"

'sheet3 name is vba project sheet name (show in vba code/vba project)

Sheet3.Range("a1").Value = "sheet 3 using"

End Sub

Read More