1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135
|
Private Sub SurveyGenerationCountry(ByVal rowCountry As DataRow)
Dim strTemplateFileName As String
Dim strOutputFileName As String
strTemplateFileName = ConfigurationSettings.AppSettings.Item("SurveyTemplateDirectory")
strTemplateFileName &= ConfigurationSettings.AppSettings.Item("SurveyTemplateFile")
strOutputFileName = ConfigurationSettings.AppSettings.Item("SurveyDirectory")
strOutputFileName &= Trim(CType(rowCountry("nomFichierSondage"), String))
strOutputFileName &= ".doc"
Try
Dim DocManager As New SurveyMSWordDoc(strTemplateFileName, strOutputFileName, rowCountry("siglePays"), Now.Year - 1, "EN")
'GenerateSurvey------------------------------------------------------------------------------------------'
DocManager.GenerateSurvey()
'GenerateSurvey------------------------------------------------------------------------------------------'
Dim WordApp As New Word.ApplicationClass
Dim missingValue As Object = Type.Missing
Dim dtStructure As DataTable
'Remplissage de la DT avec les données récupérées en BDD
dtStructure = GetSurveyFileDataFromSql()
_Doc = WordApp.Documents.Add(_sTemplateFileName, missingValue)
_Doc.Range(0, _Doc.Characters.Count - 1).Delete()
_Doc.PageSetup.Orientation = _Doc.PageSetup.Orientation.wdOrientLandscape
WordApp.Visible = False
Dim nCurrentChapter As Integer = 1
Dim dv As DataView
Dim bChapiterExist As Boolean = True
dv = New DataView(dtStructure)
Try
While bChapiterExist = True
dv.RowFilter = "noChapitre = " & nCurrentChapter
dv.Sort = "noChapitre, noSousChapitre, noRubrique"
If dv.Count > 0 Then
'AddChapterSurvey------------------------------------------------------------------------------------------'
AddChapterSurvey(nCurrentChapter, dv)
'AddChapterSurvey------------------------------------------------------------------------------------------'
Dim rng As Word.Range = _Doc.Range(_Doc.Characters.Count - 1, _Doc.Characters.Count - 1)
Try
rng.Text = "Chapitre " & nCurrentChapter & " - " & dvStructure.Item(0).Item("nomLibelle")
rng.ParagraphFormat.Style = _CHAPTER_STYLE
Catch ex As Exception
Throw ex
End Try
'AddChapterSurvey------------------------------------------------------------------------------------------'
'FillChapterSurveyTable------------------------------------------------------------------------------------------'
FillChapterSurveyTable(nCurrentChapter, dv)
'FillChapterSurveyTable------------------------------------------------------------------------------------------'
Dim rng As Word.Range = _Doc.Range(_Doc.Characters.Count - 1, _Doc.Characters.Count - 1)
_Doc.Tables.Add(rng, dvStructure.Count - 1, 6)
Dim tbl As Word.Table = _Doc.Tables.Item(nCurrentChapter)
Dim nCurRow As Integer
Dim nNbSousRubrique As Integer
tbl.Columns.Item(1).SetWidth(_RUB_NB_COL_WIDTH, Word.WdRulerStyle.wdAdjustNone)
tbl.Columns.Item(2).SetWidth(_RUB_COL_WIDTH, Word.WdRulerStyle.wdAdjustNone)
tbl.Columns.Item(3).SetWidth(_LAST_REP_COL_WIDTH, Word.WdRulerStyle.wdAdjustNone)
tbl.Columns.Item(4).SetWidth(_CURRENT_REP_COL_WIDTH, Word.WdRulerStyle.wdAdjustNone)
tbl.Columns.Item(5).SetWidth(_COMMENT_COL_WIDTH, Word.WdRulerStyle.wdAdjustNone)
tbl.Columns.Item(6).SetWidth(_VALIDATION_COL_WIDTH, Word.WdRulerStyle.wdAdjustNone)
' Méthode avec word XP/2002 :
tbl.Borders.OutsideLineStyle = Word.WdLineStyle.wdLineStyleSingle
tbl.Borders.InsideLineStyle = Word.WdLineStyle.wdLineStyleSingle
Try
For nCurRow = 1 To tbl.Rows.Count
If dvStructure.Item(nCurRow).Item("noRubrique") = 0 Then
nNbSousRubrique = 1
tbl.Cell(nCurRow, 1).Merge(tbl.Cell(nCurRow, 2))
tbl.Cell(nCurRow, 1).Range.ParagraphFormat.Style = _SUB_CHAPTER_STYLE
tbl.Cell(nCurRow, 1).Range.Text = dvStructure.Item(nCurRow).Item("nomLibelle")
tbl.Cell(nCurRow, 2).Range.ParagraphFormat.Style = _LAST_YEAR_RESPONSE_STYLE
tbl.Cell(nCurRow, 3).Range.ParagraphFormat.Style = _CURRENT_RESPONSE_STYLE
tbl.Cell(nCurRow, 4).Range.ParagraphFormat.Style = _COMMENT_STYLE
tbl.Cell(nCurRow, 5).Range.ParagraphFormat.Style = _STATUS_STYLE
If Not TypeOf dvStructure.Item(nCurRow).Item("lastResponse") Is DBNull Then
tbl.Cell(nCurRow, 2).Range.Text = dvStructure.Item(nCurRow).Item("lastResponse")
End If
Else
tbl.Cell(nCurRow, 1).Range.ParagraphFormat.Style = _RUB_NUMBER_STYLE
tbl.Cell(nCurRow, 1).Range.Text = nNbSousRubrique
tbl.Cell(nCurRow, 2).Range.Text = dvStructure.Item(nCurRow).Item("nomLibelle")
tbl.Cell(nCurRow, 2).Range.ParagraphFormat.Style = _RUB_STYLE
tbl.Cell(nCurRow, 3).Range.ParagraphFormat.Style = _LAST_YEAR_RESPONSE_STYLE
tbl.Cell(nCurRow, 4).Range.ParagraphFormat.Style = _CURRENT_RESPONSE_STYLE
tbl.Cell(nCurRow, 5).Range.ParagraphFormat.Style = _COMMENT_STYLE
tbl.Cell(nCurRow, 6).Range.ParagraphFormat.Style = _STATUS_STYLE
If Not TypeOf dvStructure.Item(nCurRow).Item("lastResponse") Is DBNull Then
tbl.Cell(nCurRow, 3).Range.Text = dvStructure.Item(nCurRow).Item("lastResponse")
End If
nNbSousRubrique = nNbSousRubrique + 1
End If
Next
rng = _Doc.Range(_Doc.Characters.Count - 1, _Doc.Characters.Count - 1)
rng.ParagraphFormat.Style = "Normal"
Catch ex As Exception
Throw ex
End Try
'FillChapterSurveyTable------------------------------------------------------------------------------------------'
nCurrentChapter = nCurrentChapter + 1
Else
bChapiterExist = False
End If
End While
Catch ex As Exception
Throw ex
Finally
_Doc.SaveAs(_sFileName)
_Doc.Close()
WordApp.Quit()
End Try
'GenerateSurvey------------------------------------------------------------------------------------------'
Catch ex As Exception
lblInformationFoot.Text = ex.ToString
End Try
End Sub' VBScript source code |
Partager