• Open word document
• create new module
• paste below method
  • Sub test()
    SetHeaderValue InputBox(“Set Header”, “Enter Header”)
    End Sub
    Sub SetHeaderValue(strHeaderValue As String)
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.MoveDown Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.TypeText Text:=strHeaderValue
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
    End Sub
• Here we are creating one method SetHeaderValue which take one parameter as string, provide you header value in that parameter.
• For testing i had created one method sub test() which invoke SetHeaderValue passing string parameter from input box.

Best wishes.

Please follow below steps :

• Create module and paste below code to create test macro

sub test()

msgBox “Test macro”

end sub()

• Now move to main document
• click on insert
• select field
• From Field Dialog select “Field names” as “Macro Button”
• In Field Properties area Type “Click to invoke macro” in Display Text
• And from Macro name select “test”
• Click on Ok button
• To test click on the field.

Best wishes.

Regards,

Brijraj Rathod

Please use below code to print user form for landscape functionallty.

Option Explicit

Private Declare Sub keybd_event Lib “user32″ (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1

Private Sub CommandButton1_Click()
DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + _
KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + _
KEYEVENTF_KEYUP, 0
DoEvents
Workbooks.Add
Application.Wait Now + TimeValue(“00:00:01″)
ActiveSheet.PasteSpecial Format:=”Bitmap”, Link:=False, _
DisplayAsIcon:=False
ActiveSheet.Range(“A1″).Select
‘added to force landscape
ActiveSheet.PageSetup.Orientation = xlLandscape
Dim pgsetup As PageSetup
Set pgsetup = ActiveSheet.PageSetup

With ActiveSheet.PageSetup
.PrintTitleRows = “”
.PrintTitleColumns = “”
End With
ActiveSheet.PageSetup.PrintArea = “”

With ActiveSheet.PageSetup
.LeftHeader = “”
.CenterHeader = “”
.RightHeader = “”
.LeftFooter = “”
.CenterFooter = “”
.RightFooter = “”
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveWorkbook.Close False
End Sub

Calendar Control provide proper interface to user for date selection. MS-Access has this Calendar Control facility, and more over it is really easy to use.

For Tutorial File  click here

Code :

Option Compare Database
Option Explicit

Private Sub cal01_DblClick()
txtRptDate.SetFocus
txtRptDate.Value = Format(cal01.Value, “dd-MMM-yyyy”)
cal01.Visible = False
End Sub

Private Sub cmdGetReport_Click()
If IsDate(txtRptDate.Value) Then
””””””””””””””’
DoCmd.RunSQL “Insert into tData (idate,iDetails) values(#” & txtRptDate.Value & “#,’Text Entered on ‘& now())”
DoCmd.OpenReport “RptData”, acViewPreview, , “idate=#” & txtRptDate.Value & “#”
””””””””””””””’
Else
MsgBox “Please select date”
End If
End Sub

Private Sub cmdShowCalender_Click()
If cal01.Visible = False Then cal01.Visible = True
End Sub

Private Sub Detail_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If cal01.Visible = True Then txtRptDate.SetFocus: cal01.Visible = False
End Sub

Timer is useful functionality in MS-Access Application, specially when we need to calculate time different.

I had uploaded new tutorial file, please refer it.

Main focus is on event Private Sub Form_Timer() and other property like

Me.TimerInterval = 1000 will set timer interval

Me.TimerInterval = 0 will disable timer.

Moreover “datediff” function is also very import function.

Tutorial File download

Best wishes.

To download tutorial file click here

Tutorial :

Developed in Excel 2003.

Option Explicit

””””””””’Developed by brijraj rathod
Private Sub cmdSearch_Click()
search_In_Recent_Document (InputBox(“Please Enter Proper Search Criteria”, “Enter Word”, “”))
End Sub

Sub search_In_Recent_Document(SEARCH_FOR As String)

”””””””””””””””””
Dim mWord As New Word.Application
Dim irow As Long
Dim iFileCounter As Long
Dim iNumberOfWordMatch As Long

With Sheet1
.Cells(1, 1) = “File Name”
.Cells(1, 2) = “No.Of.Match Case”
.Range(“A1:B1″).Font.Bold = True
End With

irow = 2
On Error GoTo Error_Handler
For iFileCounter = 1 To mWord.RecentFiles.Count
””””””””””””””””””
mWord.RecentFiles(mWord.RecentFiles.Count).Open
””””””””””””””””””
With mWord
.Selection.WholeStory
.Selection.Find.ClearFormatting

With .Selection.Find

Sheet1.Cells(irow, 1) = mWord.Documents(1).Path & “\” & mWord.Documents(1).Name
Debug.Print Sheet1.Cells(irow, 1)
”””””””””””””””’
”””””””””””””””’
.Text = SEARCH_FOR
.Replacement.Text = “”
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
”””””””””””””””’
”””””””””””””””’
iNumberOfWordMatch = 0
Do
.Execute
If .Found = True Then iNumberOfWordMatch = iNumberOfWordMatch + 1
Loop While .Found = True
”””””””””””””””’
”””””””””””””””’
Sheet1.Cells(irow, 2) = iNumberOfWordMatch
irow = irow + 1
End With
End With
”””””””””””””””’
”””””””””””””””’
Next
mWord.Quit
Exit Sub
Error_Handler:
MsgBox Err.Description
mWord.Quit
”””””””””””””””””
End Sub

Best Wishes.

Please download following file for the tutorial for ,

VBA Excel : How to create list and convert list into range dynamically.

To download tutorial file click here

Coode details :

Dim iRange As Range

Private Sub ToggleButton1_Click()
Me.Cells(1, 1) = “Cell Range :” ”’ Creating cell range you can store range to any cell
If Me.Cells(1, 2) = “” Or Me.Cells(1, 2) = “A3:AE7″ Then ”’ Checking whether this is first time or list had been already created
Me.Cells(1, 2) = “A3:AE7″ ”’ initail list
End If
Set iRange = Range(Me.Cells(1, 2))  ””” setting Range
If Me.ListObjects.Count = 0 Then
ToggleButton1.Caption = “Create List”   ””’Changing Caption
Else
ToggleButton1.Caption = “Convert To Range”   ””’Changing Caption
End If

If ToggleButton1.Caption = “Create List” Then
Me.ListObjects.Add(xlSrcRange, iRange, , xlYes).Name = “List1″
ToggleButton1.Caption = “Convert To Range”
Else
Me.Cells(1, 2).Select
Me.Cells(1, 2) = Me.ListObjects(1).Range.Address

Set iRange = Me.ListObjects(1).Range
Me.ListObjects(1).Unlist
ToggleButton1.Caption = “Create List”
End If
End Sub

Use below code for sending email.

DoCmd.SendObject acSendReport,”RptName”,acFormatRTF,”To”,”cc”,”bcc”,”Subject”,”Message Text”,”EditMessage”

For further information please refer below link.

http://msdn.microsoft.com/en-us/library/aa141552(office.10).aspx

Solution :

use below code in startup form

DoCmd.ShowToolbar “Ribbon”, acToolbarNo

How to pass listbox as parameter in function or procedure.

Solution :

We need to pass list box as parameter by reference.

Try below Code :

‘——————————————————-
Private Sub Command2_Click()
””””””””””””’
Dim lst As ListBox
Set lst = List0
lst.RowSourceType = “Value List”
writeLstBoxtoTable lst
””””””””””””’
End Sub

‘——————————————————-

Sub writeLstBoxtoTable(ByRef lst As ListBox)
”””””””””””””””””””
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset(“select * from tName”)  ”” apply proper query
””””””””””””””””
While rs.EOF = False
””””””””
lst.AddItem Trim(rs.Fields(“FirstName”)) ”’ apply proper field name
rs.MoveNext
””””””””
Wend
””””””””””””””””
Set rs = Nothing
”””””””””””””””””””
End Sub

‘——————————————————-