Skip to content

Instantly share code, notes, and snippets.

@sagarjhaa
Last active November 12, 2019 20:32
Show Gist options
  • Save sagarjhaa/a11e1e8e6a9950ac4c630af105a48c8f to your computer and use it in GitHub Desktop.
Save sagarjhaa/a11e1e8e6a9950ac4c630af105a48c8f to your computer and use it in GitHub Desktop.
Example of macro for excel.
Option Explicit
Sub Macro1()
'
' Macro1 Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "lblAddress"
.Replacement.Text = "Sagar Hga asd"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
End Sub
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "lblPAddressline1"
.Replacement.Text = "Something"
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Private Sub Command91_Click()
'Sagar Jha
'Create Word Doc
'Word Builder'
Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSelection As Word.Selection
Dim myrange As Word.Range
Dim strSQL As String
Dim rs
Dim newfilename As String
newfilename = "Sagar " + CStr(Format(Time, "HH.mm.ss")) + ".docx"
Dim leadID As Integer
leadID = Forms![Clearance]![ClearID]
Set objWord = CreateObject("Word.Application")
Set objDoc = GetObject("C:\Users\Sagar\Desktop\Sample1.docx")
objWord.Visible = False
Set myrange = objDoc.Content
'Labels used in the Sample word document
Dim lblPAddressline1 As String
Dim lblPAddressline2 As String
Dim lblOwnerName As String
Dim lblOwnerAddressline1 As String
Dim lblOwnerAddressline2 As String
Dim lblOwnercell As String
Dim lblAssessmentDate As String
Dim lblAssessmentName As String
Dim lbllicence As String
Dim lblYear As String
'Set the values of the labels
'lblPAddressline1 = "lblPAddressline1"
'lblPAddressline2 = "lblPAddressline2"
'lblOwnerName = "lblOwnerName"
'lblOwnerAddressline1 = "lblOwnerAddressline1"
'lblOwnerAddressline2 = "lblOwnerAddressline2"
'lblOwnercell = "lblOwnercell"
'lblAssessmentDate = "lblAssessmentDate"
'lblAssessmentName = "lblAssessmentName"
'lbllicence = "lbllicence"
strSQL = "SELECT tblUnitsMasterList.StNum , tblUnitsMasterList.StName, tblUnitsMasterList.Unit, tblUnitsMasterList.CityID, " & _
"tblUnitsMasterList.ZipCode,tblUnitsMasterList.YrBuilt,tblCities.City,tblClearance.ClearDate,tblInspectors.Name " & _
"FROM tblClearance , tblUnitsMasterList,tblInspectors ,tblCities " & _
"WHERE tblClearance.UnitID = tblUnitsMasterList.UnitID and tblCities.CityID = tblUnitsMasterList.CityID and tblClearance.License = tblInspectors.License and tblClearance.ClearID = " & CStr(leadID)
Set rs = CurrentDb.OpenRecordset(strSQL)
rs.MoveFirst
If (Nz(rs.Fields("StNum"), -1) = -1) Then
'It Means value is null
Else
lblPAddressline1 = rs.Fields("StNum")
End If
If (Nz(rs.Fields("StName"), -1) = -1) Then
'It Means value is null
Else
lblPAddressline1 = lblPAddressline1 + " " + rs.Fields("StName")
End If
If (Nz(rs.Fields("Unit"), -1) = -1) Then
'It Means value is null
Else
lblPAddressline1 = lblPAddressline1 + " " + rs.Fields("Unit")
End If
If (Nz(rs.Fields("City"), -1) = -1) Then
'It Means value is null
Else
lblPAddressline2 = rs.Fields("City") + " ,OH"
End If
If (Nz(rs.Fields("ZipCode"), -1) = -1) Then
'It Means value is null
Else
'This means value is not null and we will replace it in the document
lblPAddressline2 = lblPAddressline2 + " " + rs.Fields("ZipCode")
End If
If (Nz(rs.Fields("ClearDate"), -1) = -1) Then
Else
lblAssessmentDate = rs.Fields("ClearDate")
FindAndReplace myrange, "lblAssessmentDate", lblAssessmentDate
End If
If (Nz(rs.Fields("Name"), -1) = -1) Then
Else
lblAssessmentName = rs.Fields("Name")
FindAndReplace myrange, "lblAssessmentName", lblAssessmentName
End If
If (Nz(rs.Fields("YrBuilt"), -1) = -1) Then
Else
lblYear = rs.Fields("YrBuilt")
FindAndReplace myrange, "lblYear", lblYear
End If
If lblPAddressline1 <> "" Then
' This is a valid address change it in the document
FindAndReplace myrange, "lblPAddressline1", lblPAddressline1
' myrange.find.Execute findtext:=lblAddress, Forward:=True
' If myrange.find.Found = True Then
' myrange.Bold = False
' myrange.Text = strPropertyAddress
' End If
End If
If lblPAddressline2 <> "" Then
' This is a valid address change it in the document
Set myrange = objDoc.Content
FindAndReplace myrange, "lblPAddressline2", lblPAddressline2
End If
objDoc.SaveAs2 (newfilename)
objWord.Quit
Set objWord = Nothing
End Sub
Public Sub FindAndReplace(myrange, find, replace)
' myrange.find.Execute findtext:=find, Forward:=True, replace:=wdReplaceAll
' If myrange.find.Found = True Then
' myrange.Bold = False
' myrange.Text = replace
' End If
myrange.Select
Selection.find.ClearFormatting
Selection.find.Replacement.ClearFormatting
With Selection.find
.Text = find
.Replacement.Text = replace
.Forward = True
.Font.ColorIndex = wdBrightGreen
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.find.Execute replace:=wdReplaceAll
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment