Code : Tout sélectionner
Sub EffacerLeFormatageDirect()
Dim oDoc As Object
Dim oDispatcher As Object
' Supprimer les puces et numérotations
EnlevePuces
' Accéder au document actif
oDoc = ThisComponent
' Étendre la sélection à l'ensemble des paragraphes de la sélection
SelectionnerLesParagraphesEntiersDeLaSelection
' Créer le dispatcher pour exécuter les commandes
oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
' Exécuter la commande pour effacer le formatage direct
Dim args() as New com.sun.star.beans.PropertyValue
oDispatcher.executeDispatch(oDoc.CurrentController.Frame, ".uno:ResetAttributes", "", 0, args())
' Obtenir la sélection et le curseur de vue
oViewCursor = oDoc.CurrentController.getViewCursor()
' Créer un curseur basé sur le paragraphe courant
oCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor)
' Définir le style de numérotation sur "None" pour enlever la liste
oCursor.NumberingStyleName = ""
' Appliquer le style de paragraphe "Standard"
oCursor.ParaStyleName = "Standard"
' Appliquer la sélection du curseur de vue au paragraphe courant
oViewCursor.gotoRange(oCursor, False)
' Réinitialiser les attributs de formatage
oViewCursor.CharWeight = com.sun.star.awt.FontWeight.NORMAL
oViewCursor.CharUnderline = com.sun.star.awt.FontUnderline.NONE ' Pas de soulignement
oViewCursor.charheight = 12
oViewCursor.CharFontName = "Calibri"
oViewCursor.CharColor = 000000 ' Couleur noire
End Sub
Sub SelectionnerLesParagraphesEntiersDeLaSelection
On Error GoTo GestionErreur
Dim oDoc As Object
Dim oViewCursor As Object
Dim oCursor As Object
Dim oStartCursor As Object
Dim oEndCursor As Object
' Obtenir le document actif
oDoc = ThisComponent
' Obtenir la sélection et le curseur de vue
oViewCursor = oDoc.CurrentController.getViewCursor()
If oViewCursor.isCollapsed Then
' Créer un curseur basé sur le paragraphe courant
oCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor)
' Aller au début du paragraphe
oCursor.gotoStartOfParagraph(False)
' Aller à la fin du paragraphe (incluant le marqueur de fin de paragraphe)
oCursor.gotoEndOfParagraph(True)
' Définir la sélection à partir de l'objet curseur
oDoc.CurrentController.select(oCursor)
Else
' Enregistrer la position de départ et de fin
cursorPrevPos = oViewCursor.Text.createTextCursorByRange(oViewCursor.Start)
cursorLastPos = oViewCursor.Text.createTextCursorByRange(oViewCursor.End)
oViewCursor.gotoRange(cursorPrevPos, False)
' Créer un curseur pour le début du paragraphe de la sélection
oStartCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor.getStart())
oStartCursor.gotoStartOfParagraph(False)
' Créer un curseur pour la fin de la sélection
oViewCursor.gotoRange(cursorLastPos, False)
oEndCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor.getEnd())
oEndCursor.gotoEndOfParagraph(False)
' Sélectionner de oStartCursor à oEndCursor
oCursor = oViewCursor.getText().createTextCursorByRange(oStartCursor)
oCursor.gotoRange(oEndCursor, True)
' Définir la sélection à partir de l'objet curseur
oDoc.CurrentController.select(oCursor)
End If
Exit Sub
GestionErreur:
Dim sErrMsg As String
sErrMsg = "Une erreur s'est produite :" & Chr(13) & Chr(13) & _
"Erreur #" & Err & ": " & Error$ & Chr(13) & _
"À la ligne " & Chr(13) & Erl & ": "
MsgBox sErrMsg, 16
End Sub
Sub StyleDuParaCourantDefaut() 'applique style paragraphe par defaut au paragraphe courant
Dim oDoc As Object
Dim oCursor As Object
Dim oParagraph As Object
Dim oStyle As String
' Vérifier si le document est un document Writer
If Not ThisComponent.supportsService("com.sun.star.text.TextDocument") Then
MsgBox "Cette macro ne fonctionne que dans un document Writer!"
Exit Sub
End If
' Obtenir le curseur de vue actuel
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor)
oText = ThisComponent.Text
' Aller au début du paragraphe
oCursor.gotoStartOfParagraph(False)
' Aller à la fin du paragraphe (incluant le marqueur de fin de paragraphe)
oCursor.gotoEndOfParagraph(True)
' Définir la sélection à partir de l'objet curseur
ThisComponent.CurrentController.select(oCursor)
' Affecter le style de paragraphe par défaut
oCursor.NumberingStyleName = "None"
oCursor.ParaStyleName = "Standard" ' Nom du style par défaut
End Sub
Sub Creer_Style_Para_TEXTE
Dim document As Object
Dim styleFamilies As Object
Dim paragraphStyles As Object
Dim numberingRules As Object
Dim paragraphStyle As Object
Dim numberingRule As Object
Dim styleExists As Boolean
MonStylePara = "TEXTE"
' Obtenir le document actif
document = ThisComponent
' Obtenir les familles de styles du document
styleFamilies = document.StyleFamilies
' Obtenir les styles de paragraphe
paragraphStyles = styleFamilies.getByName("ParagraphStyles")
' Vérifier si le style de paragraphe existe
styleExists = paragraphStyles.hasByName(MonStylePara)
If styleExists Then
' Si le style existe, le récupérer
paragraphStyle = paragraphStyles.getByName(MonStylePara)
Else
' Si le style n'existe pas, le créer
paragraphStyle = document.createInstance("com.sun.star.style.ParagraphStyle")
paragraphStyle.Name = MonStylePara
paragraphStyles.insertByName(MonStylePara, paragraphStyle)
End If
' Modifier la justification
paragraphStyle.ParaAdjust = com.sun.star.style.ParagraphAdjust.BLOCK ' Justifié
' Modifier la taille de la police
paragraphStyle.CharHeight = 12 ' Taille de la police en points
' Changer la couleur de la police
paragraphStyle.CharColor = 000000 ' Couleur noire (code RGB)
' Modifier la propriété de la couleur de fond (Blanc)
paragraphStyle.setPropertyValue("ParaBackColor", 16777215) ' Couleur blanche (RGB)
' Définir le retrait avant le texte
paragraphStyle.setPropertyValue("ParaLeftMargin", 1000) ' Retrait de 2 cm
' Définir le retrait après le texte
paragraphStyle.setPropertyValue("ParaRightMargin", 0) ' Retrait de 2 cm
' Définir l'espacement au-dessus du paragraphe
paragraphStyle.setPropertyValue("ParaTopMargin", 200) ' Espacement de 0.5 cm au-dessus
' Définir l'espacement au-dessous du paragraphe
paragraphStyle.setPropertyValue("ParaBottomMargin", 200) ' Espacement de 0.5 cm au-dessous
' Définir l'option de ne pas appliquer l'espacement entre deux paragraphes du même style
paragraphStyle.setPropertyValue("ParaContextMargin", True) ' Désactiver l'espacement entre paragraphes du même style
' Autres modifications des propriétés du style...
paragraphStyle.setPropertyValue("CharColor", 0) ' Couleur noire
paragraphStyle.setPropertyValue("CharFontName", "Calibri") ' Police Calibri
paragraphStyle.setPropertyValue("CharWeight", com.sun.star.awt.FontWeight.NORMAL) ' Police normale
' Modifier l'espacement des caractères
paragraphStyle.setPropertyValue("CharKerning", 30) ' Remplacez 30 par la valeur souhaitée en 1/1000ème de point
End Sub
Sub Appliquer_Style_Para_TEXTE_Selection
Dim oDoc As Object
Dim oViewCursor As Object
Dim oCursor As Object
Dim oTextRangeEnum As Object
Dim oTextRange As Object
Dim ParagraphStyleName As String
' Enlever les puces de la sélection
EnlevePuces
' Obtenir le document actif
oDoc = ThisComponent
' Obtenir la collection de familles de styles
oStyleFamilies = oDoc.StyleFamilies
' Obtenir la sélection et le curseur de vue
oViewCursor = oDoc.CurrentController.getViewCursor()
' Vérifier si le style de paragraphe "TEXTE" existe, sinon le créer
If MonStyleParaExiste("TEXTE") = False Then
CreerStylePara("TEXTE")
End If
ParagraphStyleName = "TEXTE"
' Accéder aux styles de paragraphe
oParagraphStyles = oStyleFamilies.getByName("ParagraphStyles")
' Sélectionner les paragraphes entiers dans la sélection
SelectionnerLesParagraphesEntiersDeLaSelection
' Obtenir le curseur de vue
oViewCursor = oDoc.CurrentController.getViewCursor()
' Créer un curseur basé sur le paragraphe courant
oCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor)
' Appliquer le style de paragraphe "Standard" à la sélection
oCursor.ParaStyleName = "Standard"
' Appliquer le style de paragraphe "TEXTE" à la sélection
oCursor.ParaStyleName = ParagraphStyleName
End Sub
Sub Corps_de_texte
' Créer le style de paragraphe "TEXTE"
Creer_Style_Para_TEXTE
' Effacer le formatage direct de la sélection
EffacerLeFormatageDirect
' Appliquer le style de paragraphe "TEXTE" à la sélection
Appliquer_Style_Para_TEXTE_Selection
End Sub
Sub TrouveLeTexteEntreBalisesEtLeMetEnGras
Dim oDoc As Object
Dim oCursor As Object
Dim oSearch As Object
Dim oFound As Object
Dim continueSearch As Integer
Dim oTextRange As Object
Dim oController As Object
Dim oViewCursor As Object
' Demander à l'utilisateur de saisir la balise à rechercher
Dim searchString As String
searchString = InputBox("Entrez la balise à rechercher :", "Rechercher une balise")
' Vérifier si l'utilisateur a annulé la saisie
If searchString = "" Then
MsgBox "Recherche annulée par l'utilisateur.", vbInformation, "Recherche annulée"
Exit Sub
End If
' Obtenir le document actif
oDoc = ThisComponent
' Créer un curseur de texte
oCursor = oDoc.Text.createTextCursor()
' Initialiser la recherche
oSearch = oDoc.createSearchDescriptor()
oSearch.SearchString = searchString
' Commencer la recherche du début du document
oCursor.gotoStart(False)
' Obtenir le contrôleur de document et le curseur de vue
oController = oDoc.getCurrentController()
oViewCursor = oController.getViewCursor()
Dim isFirst As Boolean
isFirst = True
Dim oStart As Object
i = 0
Do
' Effectuer la recherche
oFound = oDoc.findNext(oCursor, oSearch)
' Si une correspondance est trouvée
If Not IsNull(oFound) Then
If isFirst Then
oStart = oFound
isFirst = False
Else
' Créer un curseur pour le texte entre les balises
oTextRange = oDoc.Text.createTextCursorByRange(oStart.getEnd())
oTextRange.gotoRange(oFound.getStart(), True)
' Déplacer le curseur de vue sur le texte entre les balises
oViewCursor.gotoRange(oTextRange, False)
' Demander à l'utilisateur s'il veut mettre le texte en gras avec un bouton "Annuler"
continueSearch = MsgBox("Voulez-vous mettre le texte sélectionné en gras ?", 35, "Mettre en gras")
' Si l'utilisateur choisit "Oui", mettre le texte en gras
If continueSearch = 6 Then
oTextRange.CharWeight = com.sun.star.awt.FontWeight.BOLD
' Si l'utilisateur choisit "Annuler", quitter la macro
ElseIf continueSearch = 2 Then
Exit Sub
End If
' Supprimer les balises
oStart.setString("")
oFound.setString("")
isFirst = True
i = 1
End If
' Déplacer le curseur après la séquence trouvée pour continuer la recherche
oCursor.gotoRange(oFound, False)
oCursor.goRight(Len(searchString), False)
Else
' Si aucune autre correspondance n'est trouvée, quitter la boucle
If i = 0 Then
MsgBox "Fin de recherche, aucune balise trouvée", vbInformation, "Recherche terminée"
Exit Sub
End If
Exit Do
End If
Loop
MsgBox "Fin de recherche...", vbInformation, "Recherche terminée"
End Sub
Sub SoulignageOnOff
Dim oDoc As Object
Dim oText As Object
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim reponse As Integer
' Récupération des objets document et curseurs
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
' Vérification s'il y a une sélection
If oViewCursor.getString() = "" Then
MsgBox "Aucune sélection détectée. Veuillez sélectionner du texte.", 16
Exit Sub
End If
' Création d'un curseur de texte basé sur la sélection
oTextCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor)
' Vérification si le texte est souligné
If oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE Then
' Le texte est souligné
reponse = MsgBox("Le texte sélectionné est souligné. Voulez-vous enlever le soulignement ?", 36)
If reponse = 6 Then ' 6 = Oui
oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.NONE
End If
Else
' Le texte n'est pas souligné
reponse = MsgBox("Le texte sélectionné n'est pas souligné. Voulez-vous le souligner ?", 36)
If reponse = 6 Then ' 6 = Oui
oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
End If
End If
End Sub
Sub SurlignageOnOff
Dim oDoc As Object
Dim oText As Object
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim reponse As Integer
Dim choixCouleur As Integer
Dim couleurActuelle As Long
' Définition des couleurs (format hexadécimal inversé pour OOoBasic)
' En OOoBasic, les couleurs sont en format &HBBGGRR
Const JAUNE = &Hffff00 ' B:00 G:FF R:FF - Jaune vif
Const VERT = &H90EE90 ' B:90 G:EE R:90 - Vert clair
Const ROUGE = &HFF0000 ' B:00 G:00 R:FF - Rouge vif
Const GRIS_CLAIR = &HE0E0E0 ' B:E0 G:E0 R:E0 - Gris clair
' Couleurs de texte
Const TEXTE_NOIR = &H000000 ' B:00 G:00 R:00 - Noir
Const TEXTE_BLANC = &HFFFFFF ' B:FF G:FF R:FF - Blanc
' Récupération des objets document et curseurs
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
' Vérification s'il y a une sélection
If oViewCursor.getString() = "" Then
MsgBox "Aucune sélection détectée. Veuillez sélectionner du texte.", 16
Exit Sub
End If
' Création d'un curseur de texte basé sur la sélection
oTextCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor)
' Récupération de la couleur actuelle
couleurActuelle = oTextCursor.CharBackColor
' Vérification si le texte est surligné
If couleurActuelle <> -1 And couleurActuelle <> &HFFFFFF Then
' Vérifie si c'est une des couleurs de surlignage connues
Select Case couleurActuelle
Case JAUNE, VERT, ROUGE, GRIS_CLAIR
' Le texte est surligné avec une de nos couleurs
reponse = MsgBox("Le texte sélectionné est surligné. Voulez-vous enlever le surlignage ?", 36)
If reponse = 6 Then ' 6 = Oui
oTextCursor.CharBackColor = -1 ' Retour à la couleur par défaut (transparent)
oTextCursor.CharColor = TEXTE_NOIR ' Retour au texte noir
End If
Case Else
' C'est une autre couleur, on propose de la remplacer
reponse = MsgBox("Le texte a une couleur de fond différente. Voulez-vous la remplacer ?", 36)
If reponse = 6 Then ' 6 = Oui
GoTo ChoisirNouvelleCouleur
End If
End Select
Else
ChoisirNouvelleCouleur:
' Le texte n'est pas surligné
choixCouleur = InputBox("Choisissez la couleur de surlignage :" & Chr(13) & _
"1 = Jaune" & Chr(13) & _
"2 = Vert" & Chr(13) & _
"3 = Rouge" & Chr(13) & _
"4 = Gris clair" & Chr(13) & _
"Entrez le numéro de votre choix :", _
"Choix de la couleur", "1")
' Validation et application de la couleur choisie
Select Case choixCouleur
Case "1"
oTextCursor.CharBackColor = JAUNE
oTextCursor.CharColor = TEXTE_NOIR ' Texte noir sur fond jaune
Case "2"
oTextCursor.CharBackColor = VERT
oTextCursor.CharColor = TEXTE_NOIR ' Texte noir sur fond vert
Case "3"
oTextCursor.CharBackColor = ROUGE
oTextCursor.CharColor = TEXTE_BLANC ' Texte blanc sur fond rouge
Case "4"
oTextCursor.CharBackColor = GRIS_CLAIR
oTextCursor.CharColor = TEXTE_NOIR ' Texte noir sur fond gris
Case "" ' Si l'utilisateur annule
Exit Sub
Case Else
MsgBox "Choix non valide. Veuillez entrer un numéro entre 1 et 4.", 16
Exit Sub
End Select
End If
End Sub
Sub Mon_Style_Avec_Bordures
' Sélectionner les paragraphes entiers dans la sélection
SelectionnerLesParagraphesEntiersDeLaSelection
' Effacer le formatage direct de la sélection
EffacerLeFormatageDirect
Dim oText As Object
Dim oViewCursor As Object
Dim oCursor As Object
Dim oParagraphe As Object
Dim oFamilies As Object
Dim oStyle As Object
' Définir le nom du style de bordure
stylename = "MON_STYLE_BORDURE"
' Tester si le style existe, et le créer si ce n'est pas le cas
If Not LeStyleExiste(styleName) Then
CreerStyleParagraphe(stylename)
End If
' Modifier le style avec des paramètres spécifiques (couleur de bordure et position de la bordure)
ModifierLeStyle(styleName, "violet", "right")
' Appliquer le style au paragraphe
AppliqueLeStyleParagraph(styleName)
' Obtenir le curseur de vue actuel et créer un curseur de texte basé sur ce curseur
oViewCursor = ThisComponent.CurrentController.getViewCursor()
oTextCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor)
oText = ThisComponent.Text
' Effacer le soulignage de la sélection
EffaceLeSoulignage
' Se positionner tout en haut du texte de même style
' Obtenir le style du paragraphe courant
currentStyle = oTextCursor.ParaStyleName
' Monter au paragraphe précédent
oTextCursor.gotoPreviousParagraph(False)
oViewCursor.goToRange(oTextCursor, False)
' Boucle pour remonter dans le texte paragraphe par paragraphe jusqu'à trouver un paragraphe avec un style différent
While oTextCursor.ParaStyleName = currentStyle
oTextCursor.gotoPreviousParagraph(False)
oViewCursor.goToRange(oTextCursor, False)
Wend
' Revenir au paragraphe suivant après avoir trouvé un paragraphe avec un style différent
oTextCursor.gotoNextParagraph(False)
oViewCursor.goToRange(oTextCursor, False)
' Définir le texte d'appréciation
texte = "Appréciation : "
texteGauche = Split(texte, ":")(0) ' Récupérer la partie gauche du texte jusqu'au ":"
' Vérifier si le début du paragraphe correspond au texte gauche
If TesterSiDebutParagraphe(texteGauche) Then
' Se positionner au début du paragraphe
oTextCursor.gotoStartOfParagraph(False)
' Collapser au début de la sélection
oTextCursor.collapseToStart()
' Sélectionner le texte jusqu'à la longueur de texteGauche
oTextCursor.goRight(Len(texteGauche), True)
' Souligner le texte ajouté
oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
' Collapser la sélection à la fin
oTextCursor.collapseToEnd()
' Sélectionner jusqu'à la fin du paragraphe
oTextCursor.gotoEndOfParagraph(True)
' Obtenir le texte du curseur
texte = oTextCursor.String
' Chercher le caractère ":" dans le texte
iPos = InStr(texte, ":")
If iPos > 0 Then
' Collapser la sélection à la fin
oTextCursor.collapseToEnd()
oViewCursor.goToRange(oTextCursor, False)
GoTo ferme
Else
' Ajouter ": " avec un espace insécable et sans soulignement
oTextCursor.String = Chr(160) & ": "
oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.NONE
oTextCursor.collapseToEnd()
End If
End If
' Se positionner au début du paragraphe
oTextCursor.gotoStartOfParagraph(False)
' Ajouter le texte d'appréciation souligné
oTextCursor.String = texteGauche
oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
oTextCursor.collapseToEnd()
' Ajouter ": " non souligné avec un retour à la ligne
oTextCursor.String = Chr(160) & ": " & Chr(13)
oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.NONE
' Se positionner à la fin du texte
oTextCursor.collapseToEnd()
oViewCursor.goToRange(oTextCursor, False)
' Fermer le processus
ferme:
End Sub
Sub ModifierLeStyle(style As string, couleur As string, cote_gras As string) 'FONCTIONNE AVEC LA MACRO MAKEBORDER
Dim oDoc As Object
Dim oStyleFamilies, oCursor As Object
Dim oParaStyles As Object
Dim oStyle As Object
' Obtenir le document actif
oDoc = ThisComponent
oText = oDoc.Text
oCursor = oDoc.CurrentController.getViewCursor()
oDoc = ThisComponent
' Obtenir les familles de styles et les styles de paragraphe
oStyleFamilies = oDoc.StyleFamilies
oParaStyles = oStyleFamilies.getByName("ParagraphStyles")
oStyle = oParaStyles.getByName(style)
' Définir les propriétés de base du style de paragraphe
oStyle.ParaBackColor = RGB(255, 255, 255) ' Couleur blanche
oStyle.CharWeight = com.sun.star.awt.FontWeight.NORMAL ' Police normale
oStyle.CharPosture = com.sun.star.awt.FontSlant.NONE ' Pas d'italique
oStyle.CharUnderline = com.sun.star.awt.FontUnderline.NONE ' Pas de soulignement
oStyle.CharColor = RGB(0, 0, 0) ' Couleur noire
oStyle.CharFontName = NomPoliceGlobale ' Nom de la police globale
oStyle.CharHeight = TaillePoliceGlobale ' Taille de la police globale
oStyle.ParaBottomMargin = 200 ' Espace après le paragraphe (200 twips)
oStyle.ParaTopMargin = 100 ' Espace avant le paragraphe (100 twips)
oStyle.ParaLeftMargin = 0 ' Espace à gauche du paragraphe
oStyle.ParaRightMargin = 0 ' Espace à droite du paragraphe
oStyle.ParaFirstLineIndent = 0 ' Pas d'indentation pour la première ligne
oStyle.ParaContextMargin = True ' Ne pas ajouter d'espace entre paragraphes de même style
' Justifier le texte
oStyle.ParaAdjust = com.sun.star.style.ParagraphAdjust.BLOCK
' Modifier l'espacement des caractères
oStyle.setPropertyValue("CharKerning", 30) ' Espacement des caractères (30/1000ème de point)
' Ajouter les bordures selon le paramètre cote_gras
If cote_gras = "top" Then
oStyle.TopBorder = MakeBorder(couleur, "epaisse")
oStyle.BottomBorder = MakeBorder(couleur, "")
oStyle.LeftBorder = MakeBorder(couleur, "")
oStyle.RightBorder = MakeBorder(couleur, "")
ElseIf cote_gras = "bottom" Then
oStyle.TopBorder = MakeBorder(couleur, "")
oStyle.BottomBorder = MakeBorder(couleur, "epaisse")
oStyle.LeftBorder = MakeBorder(couleur, "")
oStyle.RightBorder = MakeBorder(couleur, "")
ElseIf cote_gras = "left" Then
oStyle.TopBorder = MakeBorder(couleur, "")
oStyle.BottomBorder = MakeBorder(couleur, "")
oStyle.LeftBorder = MakeBorder(couleur, "epaisse")
oStyle.RightBorder = MakeBorder(couleur, "")
ElseIf cote_gras = "right" Then
oStyle.TopBorder = MakeBorder(couleur, "")
oStyle.BottomBorder = MakeBorder(couleur, "")
oStyle.LeftBorder = MakeBorder(couleur, "")
oStyle.RightBorder = MakeBorder(couleur, "epaisse")
End If
' Régler l'espace entre le texte et la bordure
oStyle.TopBorderDistance = 100 ' 100 twips d'espace en haut
oStyle.BottomBorderDistance = 100 ' 100 twips d'espace en bas
oStyle.LeftBorderDistance = 100 ' 100 twips d'espace à gauche
oStyle.RightBorderDistance = 100 ' 100 twips d'espace à droite
' Définir la couleur de la bordure
Dim oBorder As New com.sun.star.table.BorderLine
If couleur = "vert" Then
oBorder.Color = RGB(83, 129, 53) ' Vert
ElseIf couleur = "rouge" Then
oBorder.Color = RGB(255, 0, 0) ' Rouge
ElseIf couleur = "bleu" Then
oBorder.Color = RGB(46, 116, 181) ' Bleu
ElseIf couleur = "jaune" Then
oBorder.Color = RGB(255, 192, 0) ' Jaune
ElseIf couleur = "orange" Then
oBorder.Color = RGB(196, 89, 17) ' Orange
ElseIf couleur = "violet" Then
oBorder.Color = RGB(112, 48, 160) ' Violet
End If
' Définir l'épaisseur de la bordure
If epaisseur = "tres_epaisse" Then
oBorder.OuterLineWidth = 300 ' Très épaisse
ElseIf epaisseur = "epaisse" Then
oBorder.OuterLineWidth = 200 ' Épaisse
ElseIf epaisseur = "moyenne" Then
oBorder.OuterLineWidth = 100 ' Moyenne
ElseIf epaisseur = "fine" Then
oBorder.OuterLineWidth = 25 ' Fine
Else
oBorder.OuterLineWidth = 0 ' Pas de bordure
End If
End Sub
Sub AppliqueLeStyleParagraph(style As String)
Dim oDoc As Object
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim oPara As Object
Dim sStyleName As String
' Nom du style à appliquer
sStyleName = style
' Obtenir le document actuel
oDoc = ThisComponent
' Obtenir le curseur de vue actuel
oViewCursor = oDoc.CurrentController.getViewCursor()
' Créer un curseur de texte à partir de la position actuelle du curseur de vue
oTextCursor = oDoc.Text.createTextCursorByRange(oViewCursor)
' Si le curseur de texte est effondré (pas de sélection)
If oTextCursor.IsCollapsed Then
' Aller au début du paragraphe actuel
oTextCursor.gotoStartOfParagraph(False)
' Aller à la fin du paragraphe actuel
oTextCursor.gotoEndOfParagraph(True)
End If
' Appliquer le style de paragraphe
oTextCursor.ParaStyleName = sStyleName
End Sub
Function LeStyleExiste(styleName As String) As Boolean 'FONCTIONNE NE PAS EFFACER
Dim oDoc As Object
Dim oStyles As Object
Dim oStyle As Object
' Obtenir le document actuel
oDoc = ThisComponent
' Obtenir les styles de paragraphe du document
oStyles = oDoc.StyleFamilies.getByName("ParagraphStyles")
' Désactiver la gestion des erreurs pour tester l'existence du style
On Error Resume Next
' Essayer d'obtenir le style par son nom
oStyle = oStyles.getByName(styleName)
' Réactiver la gestion des erreurs
On Error GoTo 0
' Vérifier si le style existe
If Not IsNull(oStyle) Then
' Si le style existe, renvoyer True
StyleExiste = True
Else
' Si le style n'existe pas, renvoyer False
StyleExiste = False
End If
End Function
Sub TesterSiDebutParagraphe(debut As String) As Boolean
Dim oDoc As Object
Dim oText As Object
Dim oVC As Object
Dim oPara As Object
Dim sText As String
Dim sExpression As String
Dim iPos As Integer
' Initialiser les objets document et texte
oDoc = ThisComponent
oText = oDoc.Text
oVC = oDoc.CurrentController.getViewCursor()
oViewCursor = ThisComponent.CurrentController.getViewCursor()
' Obtenir le paragraphe courant
oPara = oVC.Text.createTextCursorByRange(oVC.getStart())
oPara.gotoStartOfParagraph(False)
oPara.gotoEndOfParagraph(True)
' Déplacer le curseur de vue à la position du curseur de texte
oViewCursor.goToRange(oPara, False)
' Extraire le texte du paragraphe
sText = Trim(oPara.String)
sExpression = Trim(debut)
' Chercher l'expression au début du paragraphe
iPos = InStr(sText, sExpression)
' Tester la présence de l'expression
If iPos = 1 Then
' MsgBox "Le paragraphe commence par '" & sExpression & "'.", 64, "Résultat de la recherche"
TesterSiDebutParagraphe = True
Else
' MsgBox "Le paragraphe ne commence pas par '" & sExpression & "'.", 48, "Résultat de la recherche"
TesterSiDebutParagraphe = False
End If
End Sub
Sub CreerStyleParagraphe(styleName As String)
Dim oDoc As Object
Dim oStyleFamilies As Object
Dim oParaStyles As Object
Dim oStyle As Object
' Obtenir le document actuel
oDoc = ThisComponent
' Obtenir les familles de styles du document
oStyleFamilies = oDoc.StyleFamilies
' Obtenir les styles de paragraphe du document
oParaStyles = oStyleFamilies.getByName("ParagraphStyles")
' Vérifier si le style existe déjà
If oParaStyles.hasByName(styleName) Then
' Si le style existe déjà, quitter la macro
'MsgBox "Le style '" & styleName & "' existe déjà.", vbInformation, "Information"
Exit Sub
End If
' Créer le style de paragraphe s'il n'existe pas
oStyle = oDoc.createInstance("com.sun.star.style.ParagraphStyle")
' Insérer le nouveau style de paragraphe dans les styles de paragraphe
oParaStyles.insertByName(styleName, oStyle)
' Afficher un message indiquant que le style a été créé avec succès
MsgBox "Le style '" & styleName & "' a été créé.", vbInformation, "Succès"
End Sub
Function MonStyleParaExiste (MonStylePara as string) as boolean 'FONCTIONNE
'test si format numérique existe
' exemple appel: StyleNumExiste("Numbering 123")
Dim oStyleFamilies, oParaStyles, oStyle as object
oStyleFamilies=ThisComponent.getstyleFamilies()
oParaStyles=oStyleFamilies.getByName("ParagraphStyles")
MonStyleParaExiste=False
For each oStyle in oParaStyles
' msgbox oStyle.Name
if oStyle.Name=MonStylePara Then
MonStyleParaExiste=true
exit For
EndIf
next
'msgbox MonStyleParaExiste
end Function
Sub EffaceLeSoulignage
Dim oDoc As Object
Dim oText As Object
Dim oViewCursor As Object
Dim oTextCursor As Object
Dim reponse As Integer
' Récupération des objets document et curseurs
oDoc = ThisComponent
oViewCursor = oDoc.CurrentController.getViewCursor()
' Vérification s'il y a une sélection
If oViewCursor.getString() = "" Then
'MsgBox "Aucune sélection détectée. Veuillez sélectionner du texte.", 16
Exit Sub
End If
' Création d'un curseur de texte basé sur la sélection
oTextCursor = oViewCursor.getText().createTextCursorByRange(oViewCursor)
' Vérification si le texte est souligné
If oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE Then
' Le texte est souligné
'reponse = MsgBox("Le texte sélectionné est souligné. Voulez-vous enlever le soulignement ?", 36)
' If reponse = 6 Then ' 6 = Oui
oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.NONE
'End If
Else
' Le texte n'est pas souligné
'reponse = MsgBox("Le texte sélectionné n'est pas souligné. Voulez-vous le souligner ?", 36)
'If reponse = 6 Then ' 6 = Oui
' oTextCursor.CharUnderline = com.sun.star.awt.FontUnderline.SINGLE
'End If
End If
End Sub
