Public Path_Liste_fichier_bld() As String Public Fichier_Word_Rapport As New Class_Word_rapport Public Fichier_Word_Fuite As New Class_Word_Fuite Public Path_wordFuite As String = ""
Private Sub Button_Rapport_Click(sender As Object, e As EventArgs) Handles Button_Rapport.Click Fichier_Word_Rapport.rapport_Word(Label_chemin_rapport_Word_choisi.Text, Path_Liste_fichier_bld.Count - 1, Path_wordFuite) End Sub
Imports Word = Microsoft.Office.Interop.Word Imports System.IO Public Class Class_Word_rapport Dim appWord As Word.Application Dim DocWord As Word.Document Dim DocRang As Word.Range Public Selection As Word.Selection Dim oPara1 As Word.Paragraph Dim oTabl As Word.Table Dim oPara2 As Word.Paragraph Dim oPara3 As Word.Paragraph Dim oImage As Word.InlineShape Dim Donnée_mesure As Class_Excel.Structure_mesure Dim GB_mesure As UserControl_FichierExcel Dim GB_EtatOuverture As UserControl_etat_ouverture_mesure Dim Pesse_papier_mémoire As Object Public Sub rapport_Word(Path_Trame_Word As String, nb_mesure As Integer, Path_Word_fuite As String) appWord = New Word.Application appWord.Visible = True 'DocWord = New Word.Document DocWord = appWord.Documents.Add(Path_Trame_Word) System.Threading.Thread.Sleep(500) Selection = appWord.Selection Insertion_Photo_1er_page() Info_Bâtiment() PartieAdmin(nb_mesure) If VérificationSélection_Bookmarks("Essai_debut") Then For index As Integer = 0 To nb_mesure info_mesure(index) Next Else Debug.Print("Il n'y a pas de signer Essai_début") End If tableau_synthese_resultats(nb_mesure) If nb_mesure > 0 Then tableau_calcul_valeurs_pondérés(nb_mesure) End If If VérificationSélection_Bookmarks("Recherche_de_fuite") And Path_Word_fuite <> "" Then Form1.Fichier_Word_Fuite.Word_fuite(Path_Word_fuite, DocWord) Else Debug.Print("Il n'y a pas de signer Recherche de fuite ou le chemin pour le fichier word des fuites n'est pas enregistré") End If DocWord.Activate() insertion_certifica_étalonnage() MessageBox.Show("Rapport fini") End Sub
Imports Word = Microsoft.Office.Interop.Word Public Class Class_Word_Fuite Dim appWord_fuite As Word.Application Dim DocWord_fuite As Word.Document Dim DocRang_fuite As Word.Range Dim Selection_rapport As Word.Selection 'Dim DocWord2 As Word.Document Dim DocRang2 As Word.Range Dim Selection2 As Word.Selection Public Structure Structure_fuite Dim photo As Image Dim localisation As String Dim Description As String Dim vignette As String Dim Propostion_amélioration As String Dim Type_Fuite_Registre_Chapitre As String Dim Type_Fuite_Registre_Sous_Chapitre As String End Structure Public Sub Word_fuite(Path_Word_fuite As String, DocWord2 As Word.Document) Selection_rapport = Form1.Fichier_Word_Rapport.Selection ' On récuper la sélection faite dans le fichier word rapport au niveau du Bookmarks appWord_fuite = New Word.Application appWord_fuite.Visible = True 'DocWord = New Word.Document DocWord_fuite = appWord_fuite.Documents.Add(Path_Word_fuite) ' Ouverture du document avec les fuites System.Threading.Thread.Sleep(500) Selection2 = appWord_fuite.Selection 'DocWord = New Word.Document ' DocWord2 = appWord.Documents.Add() ' System.Threading.Thread.Sleep(500) Dim compteur As Integer = 0 ' Dim tableau_temp As Word.Table For Each IndexTableau As Word.Table In DocWord_fuite.Content.Tables 'IndexTableau.Range.Shading.BackgroundPatternColorIndex = Word.WdColorIndex.wdRed If Hex(Asc(IndexTableau.Cell(1, 1).Range.Text.ToString)) = "4E" Then Debug.Print("il s'agie du 1er type de tableau") Debug.Print("Tableau n°" & compteur & " nb ligne " & IndexTableau.Rows.Count) ElseIf IndexTableau.Cell(1, 1).Range.Text.ToString.IndexOf("Plan") <> -1 Then If IndexTableau.Cell(1, 1).Range.Text.ToString.IndexOf("Extrait") = -1 Then ' plans générale Dim page_paysage As Boolean = True ' il faut testé l'orientation du plans dans le rapport d'origine et si en paysage on fais cela : insertion_ligne() déplacement_Selection(1) If page_paysage Then insertion_saute_section() déplacement_Selection(1) With Selection_rapport.PageSetup .LineNumbering.Active = False .Orientation = Word.WdOrientation.wdOrientLandscape .TopMargin = appWord_fuite.CentimetersToPoints(3.75) .LeftMargin = appWord_fuite.CentimetersToPoints(1.27) .RightMargin = appWord_fuite.CentimetersToPoints(1.27) .DifferentFirstPageHeaderFooter = False End With End If 'Selection_rapport.Range.Sections.Add(Selection_rapport.Range) ' Selection_rapport.MoveDown(Word.WdUnits.wdParagraph, 1) 'Selection_rapport.Range.InsertParagraphAfter() 'Selection_rapport.Range.PageSetup.Orientation = Word.WdOrientation.wdOrientLandscape Debug.Print("il s'agie d'un plans générale") Debug.Print("Tableau n°" & compteur & " nb ligne " & IndexTableau.Rows.Count) IndexTableau.Range.Copy() coller_tableau() System.Threading.Thread.Sleep(150) Dim insertion As Boolean = False compteur = 0 Do Until insertion Try Selection_rapport.Tables(1).Cell(2, 1).Select() ' on se met à la fin du tableau Exit Do Catch ex As Exception Debug.Print("erreur pour sélection tableau du plans général " & "tentative n°" & compteur) Debug.Print(ex.Message) System.Threading.Thread.Sleep(200) End Try compteur = compteur + 1 If compteur = 5 Then insertion = True 'Echec de l'insertion on quitte le DO Debug.Print("Echec de la sélection du tableau") End If Loop Do While Selection_rapport.Information(Word.WdInformation.wdWithInTable) déplacement_Selection(1) Loop insertion_ligne() déplacement_Selection(1) If page_paysage Then insertion_saute_section() déplacement_Selection(1) With Selection_rapport.PageSetup .LineNumbering.Active = False .Orientation = Word.WdOrientation.wdOrientPortrait .TopMargin = appWord_fuite.CentimetersToPoints(3.75) .LeftMargin = appWord_fuite.CentimetersToPoints(1.27) .RightMargin = appWord_fuite.CentimetersToPoints(1.27) .BottomMargin = appWord_fuite.CentimetersToPoints(1.27) .DifferentFirstPageHeaderFooter = False End With End If Else ' extrais de plans insertion_ligne() déplacement_Selection(1) Debug.Print("il s'agie d'un tableau pour un extrais de plans") Debug.Print("Tableau n°" & compteur & " nb ligne " & IndexTableau.Rows.Count) IndexTableau.Range.Copy() coller_tableau() System.Threading.Thread.Sleep(150) Dim insertion As Boolean = False compteur = 0 Do Until insertion Try Selection_rapport.Tables(1).Cell(2, 1).Select() ' on se met à la fin du tableau Exit Do Catch ex As Exception Debug.Print("erreur pour sélection tableau extrais de plans " & "tentative n°" & compteur) Debug.Print(ex.Message) System.Threading.Thread.Sleep(200) End Try compteur = compteur + 1 If compteur = 5 Then insertion = True 'Echec de l'insertion on quitte le DO Debug.Print("Echec de la sélection du tableau") End If Loop Do While Selection_rapport.Information(Word.WdInformation.wdWithInTable) déplacement_Selection(1) Debug.Print("Déplacement dans le tableau plans") Loop insertion_ligne() déplacement_Selection(1) End If ElseIf IndexTableau.Cell(1, 1).Tables.Count > 0 Then ' tableau avec les photos et les remarques Debug.Print("il s'agie du tableau photos") ' IndexTableau.Cell(1, 1). Debug.Print("Tableau n°" & compteur & " nb ligne " & IndexTableau.Rows.Count) 'on va le modifir avant de le copier Dim compteur_ligne As Integer = 0 For Each Row_in_tab As Word.Row In IndexTableau.Rows For Each colums_in_tab As Word.Cell In Row_in_tab.Cells For Each Tableau_in_tableau In colums_in_tab.Tables Debug.Print("Modification du Tableau n° " & compteur_ligne & " dans le tableau") ' Selection_rapport.Range.InsertParagraphAfter() 'System.Threading.Thread.Sleep(10) If True Then Tableau_in_tableau.Select() Selection2.Font.Name = "Calibri" Selection2.Font.Size = 11 Selection2.ParagraphFormat.SpaceBefore = 2 Selection2.ParagraphFormat.SpaceAfter = 2 Tableau_in_tableau.Rows.HeightRule = Word.WdRowHeightRule.wdRowHeightAuto ' On fait en sort que le tableau s'ajuste automatiquement au écriture Tableau_in_tableau.PreferredWidthType = Word.WdPreferredWidthType.wdPreferredWidthPoints Tableau_in_tableau.PreferredWidth = appWord_fuite.CentimetersToPoints(16) 'Selection_rapport.InlineShapes(1).Select() For Each photo_shapes As Word.InlineShape In Selection2.InlineShapes photo_shapes.Height = appWord_fuite.CentimetersToPoints(My.Settings.Taille_photos) ' on réduit la photo avec la valeur enregistré dans les paramètre photo_shapes.Line.Visible = Microsoft.Office.Core.MsoTriState.msoTrue Next ' System.Threading.Thread.Sleep(20) 'Debug.Print("NB ligne : " & Selection_rapport.Tables(1).Rows.Count & " nb celule " & Selection_rapport.Tables(1).Rows(3).Cells.Count) 'DocWord2.Tables(DocWord2.Tables.Count).Rows(DocWord2.Tables(DocWord2.Tables.Count).Rows.Count).Cells(DocWord2.Tables(DocWord2.Tables.Count).Rows(DocWord2.Tables(DocWord2.Tables.Count).Rows.Count).Cells.Count).Select() Tableau_in_tableau.Cell(1, 1).Shading.BackgroundPatternColorIndex = Word.WdColorIndex.wdAuto If Form1.CheckBox_listeFuites_PropositionAmélioration.Checked = True Then Tableau_in_tableau.Cell(4, 2).Range.Text = "Proposition d'amélioration :" ' On éfface la date qui sert à rien Tableau_in_tableau.Cell(4, 2).Range.Font.Underline = Word.WdUnderline.wdUnderlineSingle Else Tableau_in_tableau.Cell(4, 2).Range.Text = "" ' On éfface la date qui sert à rien Tableau_in_tableau.Cell(4, 2).Range.Font.Underline = Word.WdUnderline.wdUnderlineSingle End If End If Next compteur_ligne = compteur_ligne + 1 'Row_in_tab.Cells(1).Range.Select() 'Selection = appWord.Selection 'Selection.Shading.BackgroundPatternColorIndex = Word.WdColorIndex.wdDarkYellow 'Debug.Print("linge n° " & compteur_ligne & " tableau avec nb ligne " & Selection.Tables.Count) Next Next compteur_ligne = 0 For Each Row_in_tab As Word.Row In IndexTableau.Rows For Each colums_in_tab As Word.Cell In Row_in_tab.Cells For Each Tableau_in_tableau In colums_in_tab.Tables Debug.Print("Colle Tableu n° " & compteur_ligne & " dans le tableau") insertion_ligne() ' dans le word rapport déplacement_Selection(1) ' dans le word rapport Tableau_in_tableau.Range.Copy() coller_tableau() System.Threading.Thread.Sleep(150) Dim insertion As Boolean = False compteur = 0 Do Until insertion Try Selection_rapport.Tables(1).Select() Selection_rapport.Tables(1).Cell(4, 2).Select() ' on se met à la fin du tableau Exit Do Catch ex As Exception Debug.Print("erreur pour sélection tableau " & "tentative n°" & compteur) Debug.Print(ex.Message) System.Threading.Thread.Sleep(200) End Try compteur = compteur + 1 If compteur = 5 Then insertion = True 'Echec de l'insertion on quitte le DO Debug.Print("Echec de la sélection du tableau") End If Loop compteur = 0 Do While Selection_rapport.Information(Word.WdInformation.wdWithInTable) déplacement_Selection(1) System.Threading.Thread.Sleep(150) compteur = compteur + 1 If compteur = 5 Then Debug.Print("On fait une pose de 3 s") System.Threading.Thread.Sleep(3000) ElseIf compteur = 10 Then Debug.Print("On fait une pose de 10 s") System.Threading.Thread.Sleep(10000) ElseIf compteur = 15 Then Debug.Print("On fait une pose de 3 s") System.Threading.Thread.Sleep(3000) ElseIf compteur = 20 Then Debug.Print("On fait une pose de 10 s et on remet le compteur à 0") System.Threading.Thread.Sleep(10000) compteur = 0 End If Debug.Print("Déplacement dans le tableau photos n° " & compteur_ligne & " Déplacement n° " & compteur) Loop 'Selection_rapport.Range.InsertParagraphAfter() ' Selection_rapport.MoveDown(Word.WdUnits.wdParagraph, 1) 'Tableau_in_tableau.Range.Shading.BackgroundPatternColorIndex = Word.WdColorIndex.wdDarkYellow Next compteur_ligne = compteur_ligne + 1 'Row_in_tab.Cells(1).Range.Select() 'Selection = appWord.Selection 'Selection.Shading.BackgroundPatternColorIndex = Word.WdColorIndex.wdDarkYellow 'Debug.Print("linge n° " & compteur_ligne & " tableau avec nb ligne " & Selection.Tables.Count) Next Next Else Debug.Print("Autre tableau") Debug.Print("Tableau n°" & compteur & " nb ligne " & Hex(Asc(IndexTableau.Cell(1, 1).Range.Text.ToString))) Debug.Print("Tableau n°" & compteur & " nb ligne " & IndexTableau.Cell(1, 1).Range.Text.ToString) End If compteur = compteur + 1 ' Tableau de donner avec description et localisation ' Tableau avec toutes les photos ' Tableau avec le plan ' Plusieurs tableau avec les extrais de plans Next ' compteur = 0 ' For Each IndexTitre As Word.Paragraph In DocWord.Content.Paragraphs 'Debug.Print("paragraphe n°" & compteur & " " & IndexTitre.Range.Text.ToString) 'compteur = compteur + 1 'Next ' compteur = 0 ' For Each photo_shapes As Word.Shape In DocWord_fuite.Shapes ' vignette, plans, extrais de plans 'photo_shapes.Height = 100 'photo_shapes.Width = 100 ' Debug.Print("Immage n°" & compteur & " " & photo_shapes.Height) 'compteur = compteur + 1 ' Next 'compteur = 0 'For Each photo_inshapes As Word.InlineShape In DocWord_fuite.InlineShapes 'photos + localisation de l'extrais de plans 'photo_inshapes.Height = 50 'photo_inshapes.Width = 50 'Debug.Print("Immage type 2 n°" & compteur & " " & photo_inshapes.Height) ' compteur = compteur + 1 'Next appWord_fuite.Visible = True End Sub Private Sub insertion_ligne() Dim insertion As Boolean = False Dim compteur As Integer = 0 Do Until insertion Try Selection_rapport.Range.InsertParagraphAfter() ' on insert un ligne insertion = True 'insertion réussite on quitte le DO Exit Sub Catch ex As Exception Debug.Print("erreur d'insertion d'une ligne " & "tentative n°" & compteur) Debug.Print(ex.Message) System.Threading.Thread.Sleep(50) End Try compteur = compteur + 1 If compteur = 5 Then insertion = True 'Echec de l'insertion on quitte le DO Debug.Print("Echec de l'insertion de la ligne") End If Loop End Sub Private Sub déplacement_Selection(nb_linge As Integer) Dim insertion As Boolean = False Dim compteur As Integer = 0 Do Until insertion Try Selection_rapport.MoveDown(Word.WdUnits.wdParagraph, nb_linge) ' on descendre de nb ligne insertion = True 'insertion réussi on quitte le DO Exit Sub Catch ex As Exception Debug.Print("erreur de mouvement de nb ligne " & "tentative n°" & compteur) Debug.Print(ex.Message) System.Threading.Thread.Sleep(50) End Try compteur = compteur + 1 If compteur = 5 Then insertion = True 'Echec de l'insertion on quite le DO Debug.Print("Echec de du mouvement") End If Loop End Sub Private Sub insertion_saute_section() Dim insertion As Boolean = False Dim compteur As Integer = 0 Do Until insertion Try Selection_rapport.Range.InsertBreak(Word.WdBreakType.wdSectionBreakNextPage) ' on déssant de nb ligne insertion = True 'insertion réussi on quitte le DO Exit Sub Catch ex As Exception Debug.Print("erreur saut de section " & "tentative n°" & compteur) Debug.Print(ex.Message) System.Threading.Thread.Sleep(50) End Try compteur = compteur + 1 If compteur = 5 Then insertion = True 'Echec de l'insertion on quitte le DO Debug.Print("Echec de de l'insertion de saute de section") End If Loop End Sub Private Sub coller_tableau() Dim insertion As Boolean = False Dim compteur As Integer = 0 Do Until insertion Try 'Selection_rapport.Range.PasteAndFormat(Word.WdRecoveryType.wdFormatOriginalFormatting) ' on colle le tableau Selection_rapport.Range.PasteSpecial(DataType:=Word.WdPasteDataType.wdPasteRTF) insertion = True 'insertion réussie on quitte le DO Exit Sub Catch ex As Exception Debug.Print("erreur pour le collage " & "tentative n°" & compteur) Debug.Print(ex.Message) System.Threading.Thread.Sleep(50) End Try compteur = compteur + 1 If compteur = 5 Then insertion = True 'Echec de l'insertion on quitte le DO Debug.Print("Echec du collage") End If Loop End Sub Private Sub modification_oriantation_page() ' Non utilisé Dim insertion As Boolean = False Dim compteur As Integer = 0 Do Until insertion Try With Selection_rapport.PageSetup .LineNumbering.Active = False .Orientation = Word.WdOrientation.wdOrientPortrait '.TopMargin = appWord_fuite.CentimetersToPoints(2.5) .DifferentFirstPageHeaderFooter = False End With Exit Sub Catch ex As Exception Debug.Print("erreur pour le collage " & "tentative n°" & compteur) Debug.Print(ex.Message) System.Threading.Thread.Sleep(50) End Try compteur = compteur + 1 If compteur = 5 Then insertion = True 'Echec de l'insertion on quitte le DO Debug.Print("Echec du collage") End If Loop End Sub End Class
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question