Follow @dporton

Just Code : Highlight Excel Cells

Ever wanted to highlight some cells dependent on their value in Excel. This JustCode script does it for you .

Dim oExcel,oSheet1, oSheet2, oSheet3
Dim iRow,iCol,iStartRow
Dim iLastRow,iLastCol

Set oExcel = createobject("Excel.Application")

oExcel.Visible = True	

oExcel.Application.Workbooks.Open("C:\Data\SD\JustCode\temp.xlsx")



For each oSheet1 in oExcel.Sheets
	
	oSheet1.Activate()
	
	
	For iRow = 1 to 99 
		if ( find(oSheet1.cells[iRow][2].text,"Base") > -1 ) Then
			iStartRow = iRow
			Exit for
		end If
	NExt
	
	For iCol = 1 to 500
		if ( oSheet1.cells[iStartRow][iCol].text = "" ) Then
			iLastCol = iCol
			Exit for
		end If
	Next
	
	For iRow = iStartRow to 99 step 3
		if ( oSheet1.cells[iRow][2].text = "" ) Then
			iLastRow = iRow
			Exit for
		end If
	NExt
	
	
	For iRow = iStartRow to iLastRow
	
		For iCol = 3 to iLastCol
	
			If ( find(oSheet1.cells[iRow][iCol].text,"A") > -1 ) Then
				' VBA to color a cell
				oSheet1.cells[iRow][iCol].Interior.Color = RGB(0, 0, 250)
				oSheet1.cells[iRow][iCol].Font.Color  = RGB(255, 255, 255)
			End If
	
		Next
	
	Next
	
Next

oExcel.ActiveWorkbook.Save()

oExcel.Quit()

Set oExcel = null

JustCode : Read all file in one go

This JustCode shows us how to open a file in read-only mode and read all the file in one go. I find this very useful when i need to read in template files and do some sort of search and replace.

 
`’ ****************************************
 ‘ Designed by : Smarter Dimensions
 ‘ Last Updated : 24th July 2009
 ‘ Read all file in one go.
 ‘ ****************************************
 
Dim oFSO, oFile
 
Set oFSO = CreateObject(“Scripting.FileSystemObject”)
 
Set oFile = oFSO.OpenTextFile(“C:\temp\test.txt”,1,false,0)
 
debug.Log(oFile.ReadAll())
 
oFile.Close()

JustCode : Print to Word Version 1

Many moons ago , i needed to make a script that showed the users answer in a word doc. This JustCode script shows you how you can do it. Its creates a template for you and populates it.

Routing(Web)

' Set the survey Answers

Single = {A}
Multi = {A,B}
ToDaysDate="04/06/2010"

GridQuestion[{Sub1}].SingleCategoricalQuestionName = {A}
GridQuestion[{Sub2}].SingleCategoricalQuestionName = {B}
GridQuestion[{Sub3}].SingleCategoricalQuestionName = {C}
GridQuestion[{Sub4}].SingleCategoricalQuestionName = {D}
GridQuestion[{Sub5}].SingleCategoricalQuestionName = {E}

DoubleQuestioName = 12.12
LongQuestionName = 122
TextQuestionName = "This is a text question"
SingleWithOther._Other = "hello"
SingleWithOther = {_other}

Dim oWord,sFileName
Set oWord = CreateObject("Word.Application")
oWord.visible = true


' These two lines will make a template for us.
'oWord.Documents.Add()
'RunTemplate(oWord,IOM,False)


' These lines will use a template and show results
oWord.Documents.Open("D:DATASDLibraryPrintToWordSimpleTemplate.docx")
RunTemplate(oWord,IOM,True)


oWord.DisplayAlerts = false
'sFileName = "c:temp" + replace(replace(CText(DateNow()),"/","_"),":","_") + ".docx"
'oWord.ActiveDocument.SaveAs(sFileName)
oWord.Quit()

Sub MakeSpace(oWord)
' Jump out of table
oWord.Selection.MoveDown(5,1)

' Insert New line
oWord.Selection.TypeParagraph()

End Sub

Sub MakeTable(oWord,sLabel)
oWord.ActiveDocument.Tables.Add(oWord.Selection.range,2,1,1,0)

With oWord.Selection.Tables[1]
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With

oWord.Selection.Text = sLabel

End Sub

Sub Add2RowToTable(oWord,sLabel,sAnswerLabel,sAnswer)

oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer

End Sub

Sub Add1RowToTable(oWord,sLabel,sAnswerLabel,sAnswer)

oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer

End Sub

Sub AddSplitRowToTable(oWord,sLabel,sAnswerLabel,sAnswer,iRows,iCols)

oWord.Selection.MoveRight(12)
oWord.Selection.Cells.Split(iRows,iCols,True)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer

End Sub

Sub AddGridSplitRowToTable(oWord,sLabel,sAnswerLabel,sAnswer,iRows,iCols)

oWord.Selection.MoveRight(12)
oWord.Selection.Cells.Split(iRows,iCols,True)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer

End Sub

Sub AddGridRowToTable(oWord,sAnswer)

oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer

End Sub

Sub AddNextGridRowToTable(oWord,sLabel,sAnswer)

oWord.Selection.MoveRight(12)
oWord.Selection.Text = sLabel

oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer

End Sub


Sub RunTemplate(oWord,IOM,bWithAnswers)
Dim oQuestion

For Each oQuestion in IOM.Questions
Select Case oQuestion.QuestionType
Case QuestionTypes.qtSimple
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"S","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"S","",oWord,0,IOM)
End If
Case QuestionTypes.qtLoopCategorical, QuestionTypes.qtLoopNumeric
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"G","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"G","",oWord,0,IOM)
End If
Case QuestionTypes.qtBlock, QuestionTypes.qtCompound, QuestionTypes.qtPage
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"G","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"G","",oWord,0,IOM)
End If
End Select
Next
End Sub

Sub FindAnswer(oWord,sLookingFor,sValue)

With oWord.Selection.Find
.Text = sLookingFor
.Replacement.Text = sValue
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWord.Selection.Find.Execute(,,,,,,,,,,1,,,,)
oWord.Selection.Font.Size = 10
oWord.Selection.HomeKey(6)

End Sub

Sub GetAnswers(oQuestion,sType,sLabel,oWord)
Dim oCat,oItem,oOther
Select Case sType
Case = "S"
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + "X",oQuestion.Response.Value)

Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText

FindAnswer(oWord,"X" + oQuestion.QuestionFullName + "X",oQuestion.Response.Value)


Case Else
For each oCat in oQuestion.Categories
If ( oCat.Value.Format("a") = oQuestion.Response.Value.Format("a") ) Then

FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X","Yes")

Else
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X","No")

End If
Next

' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + ":OtherTextX",oOTher.OtherQuestion.response.value)
Next
End Select
Case = "G"
For each oItem in oQuestion
If ( Find(oItem.ParentQuestion.QuestionFullname,"{") > -1 ) Then
GetAnswers(oItem,"S",oQuestion.ParentQuestion.Label,oWord)
Else
GetAnswers(oItem,"G",oQuestion.Label,oWord)
End If
Next
End Select
End Sub

Sub CreateQuestions(oQuestion,sType,sLabel,oWord,iQCount,oIOM)
Dim oCat,oItem,oOther,iCat
Select Case sType
Case = "S"
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
If ( sLabel = "" ) Then
Add1RowToTable(oWord,oQuestion.Label,"","X" + oQuestion.QuestionFullName + "X")
Else
Add1RowToTable(oWord,oQuestion.Label,"","X" + sLabel + "X")
End If
Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText
If ( sLabel = "" ) Then
Add1RowToTable(oWord,oQuestion.Label,"","X" + oQuestion.QuestionFullName + "X")
Else
Add1RowToTable(oWord,oQuestion.Label,"","X" + sLabel + "X")
End If

Case Else
iCat = 0
For each oCat in oQuestion.Categories

If iCat = 0 Then
If ( sLabel = "" ) Then
AddSplitRowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,2)
Else
AddSplitRowToTable(oWord,sLabel,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,2)
End If
Else
If ( sLabel = "" ) Then
Add2RowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
Add2RowToTable(oWord,sLabel,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If

End If
iCat = iCat + 1
Next

' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
If ( sLabel = "" ) Then
Add2RowToTable(oWord,oQuestion.Label,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
Else
Add2RowToTable(oWord,sLabel,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
End If
Next
End Select
Case = "GS"
'MakeTable(oWord,oQuestion.Label)
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText
Case Else
iCat = 0

For each oCat in oQuestion.Categories
If iCat = 0 Then
If ( iQCount = 2 ) Then
If ( sLabel = "" ) Then

AddGridSplitRowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,oQuestion.Categories.count+1)
Else
AddGridSplitRowToTable(oWord,sLabel,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,oQuestion.Categories.count+1)
End If
Else
'At This stage i need to know
'oIOM.Questions["GridQuestion"].categories["Sub1"].label

If ( sLabel = "" ) Then
AddNextGridRowToTable(oWord,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
AddNextGridRowToTable(oWord,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If
End If
Else
If ( sLabel = "" ) Then
AddGridRowToTable(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
AddGridRowToTable(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If

End If
iCat = iCat + 1
Next

' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
If ( sLabel = "" ) Then
AddSimpleTable(oWord,oQuestion.Label,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
Else
AddSimpleTable(oWord,sLabel,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
End If
Next
End Select
Case = "G"

For each oItem in oQuestion
iQCount = iQCount + 1
If ( Find(oItem.ParentQuestion.QuestionFullname,"{") > -1 ) Then
CreateQuestions(oItem,"GS",oQuestion.ParentQuestion.Label,oWord,iQCount,oIOM)
Else
CreateQuestions(oItem,"G",oQuestion.Label,oWord,iQCount,oIOM)
End If
Next
End Select
End Sub

End Routing
%d bloggers like this: