This JustCode script shows you how to pad out a string with a certain amount of text characters.
Function PAD(sString,iSize,sWith) Dim iPos,sPad For iPos = 1 To iSize sPad = sPad + sWith Next PAD = right(sPad + sString,iSize) End Function
Month: February 2016
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 : Run DMS from MRS file.
This JustCode script shows you how to run a DMS script from within a mrs file. I use this allot in the automation systems i write for customers , a very useful bit of code.
Dim oDMOMJob
Set oDMOMJob = CreateObject("DMOM.Job")
oDMOMJob.Load("c:\temp\MyFirstTransfer.dms", null)
oDMOMJob.Run()
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