|
Bonjour à tous,
Je recherche des informations sur l'article Spip fait par Tony Galmiche et Robert Dargaud.Celle-ci
option explicit
sub Creer_Serie_Articles
dim Nb as integer
dim i as integer
Nb=InputBox ("Nombre d'articles à créer ?",,1)
for i=1 to Nb
Creer_Article
next i
end sub
Sub Creer_Article
Dim oDoc
Dim oSection as object
Dim oCursor As Object
Dim oSels as object
Dim oSel as object
dim NumMax as integer
dim Num as integer
dim NumArticle as string
dim Rep as integer
dim NomSection as string
dim TabNomSection as variant
dim i as integer
dim InsertFin as boolean
dim PARAGRAPH_BREAK as integer
PARAGRAPH_BREAK = com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK
oDoc=ThisComponent
oCursor = oDoc.Text.createTextCursor()
'** Recherche d'une section dans la sélection *****************************
oSels = ThisComponent.getCurrentSelection() ' Contient l'ensemble des sélections
oSel = oSels.getByIndex(0) ' Contient la 1iere selection
'**************************************************************************
NumArticle=""
InsertFin=FALSE
'** Test si la selection contient une section *****************************
If IsEmpty(oSel.TextSection) Then
InsertFin=TRUE
else
' Recherche du N° de l'article dans la sélection
NumArticle=right(oSel.TextSection.name,4)
if NumArticle>"9999" or NumArticle<"0001" then
InsertFin=TRUE
else
' Déplacement au dessus de la premiere section de l'article
oSection=oDoc.GetTextSections.GetByName("<xml:article> " & NumArticle)
oCursor.gotoRange(oSection.Anchor.Start, FALSE)
oCursor.gotoPreviousParagraph(FALSE) 'Déplacement au paragraphe précédent
oCursor.gotoPreviousParagraph(FALSE) 'Déplacement au paragraphe précédent
oCursor.gotoStartOfParagraph(FALSE) 'Déplacement au début du paragraphe
end if
end if
'** Si la sélection ne contient pas de section, insertion en fin de document
if InsertFin=TRUE then
NomSection="<xml:export_spip>"
oSection=oDoc.GetTextSections.GetByName(NomSection)
oCursor.gotoRange(oSection.Anchor.End, false)
end if
'**************************************************************************
'Recherche le dernier N° d'article créé ************************************
NumMax=0
TabNomSection= oDoc.GetTextSections.getElementNames()
for i = 0 to UBound(TabNomSection())
if left(TabNomSection(i),14)="<xml:article> " then
Num=mid(TabNomSection(i),14,100)
if Num>NumMax then NumMax=Num
end if
next i
NumArticle=right("0000" & NumMax+1,4)
'***************************************************************************
'** Création d'un curseur pour se déplacer dans le docuement ***************
'oDoc.Text.insertControlCharacter(oCursor, PARAGRAPH_BREAK, False)
'oCursor.gotoPreviousParagraph(0) 'Déplacement au paragraphe précédent
'***************************************************************************
'** Vérification que la section principale existe *************************
NomSection="<xml:export_spip>"
Rep = oDoc.GetTextSections.HasByName(NomSection)
if Rep=False then
msgbox "Section principale non trouvée !"
oSection=CreerSection(oCursor, NomSection, FALSE, RGB(255,255,255))
else
oSection=oDoc.GetTextSections.GetByName(NomSection)
end if
'***************************************************************************
'** Création de la section de l'article ************************************
oDoc.Text.insertControlCharacter(oCursor, PARAGRAPH_BREAK, False)
NomSection="Sections de l'article N°" & NumArticle
oDoc.Text.insertString(oCursor, NomSection, FALSE)
oDoc.Text.insertControlCharacter(oCursor, PARAGRAPH_BREAK, False)
NomSection="<xml:article> " & NumArticle
oSection=CreerSection(oCursor, NomSection, FALSE,RGB(255,255,255))
'***************************************************************************
'** Déplacement du curseur dans la section précédente **********************
oCursor.gotoRange(oSection.Anchor.End, false)
'***************************************************************************
'** Insertion de la nouvelle section liée à la section du 1ier article *****
oDoc.Text.insertControlCharacter(oCursor, PARAGRAPH_BREAK, False)
NomSection="entete " & NumArticle
oSection=CreerSection(oCursor, NomSection , FALSE, RGB(210,210,210))
if NumArticle<>"0001" then oSection.LinkRegion="entete 0001"
'***************************************************************************
'** Création des autres sections *******************************************
NomSection="<xml:data:texte> " & NumArticle
oSection=CreerSection(oCursor, NomSection, FALSE,RGB(220,220,220))
NomSection="<?xml version=""1.0"" encoding=""UTF-8"" ?> " & NumArticle
oSection=CreerSection(oCursor, NomSection, FALSE,RGB(230,230,230))
'***************************************************************************
End Sub
function CreerSection(oCursor as object, NomSection as string, _
Protection as boolean, Couleur as long)
dim oDoc as object
dim oSection as object
oDoc=ThisComponent
oSection = oDoc.createInstance("com.sun.star.text.TextSection")
oSection.isProtected = Protection
oSection.Name = NomSection
oSection.BackColor=Couleur
oDoc.Text.insertTextContent(oCursor, oSection, FALSE)
CreerSection=oSection
end function
sub Supprimer_Article
Dim oSels as object
Dim oSel as object
Dim oDoc as object
dim oCursor as object
dim oSection as object
dim NumArticle as string
oDoc=ThisComponent
'** Recherche d'une section dans la sélection *****************************
oSels = ThisComponent.getCurrentSelection() ' Contient l'ensemble des sélections
oSel = oSels.getByIndex(0) ' Contient la 1iere selection
'**************************************************************************
'** Test si la selection contient une section *****************************
If IsEmpty(oSel.TextSection) Then
msgbox "La sélection en cours ne contient pas d'article !",48
exit sub
end if
'**************************************************************************
'** Recherche du N° de l'article dans la sélection ************************
NumArticle=right(oSel.TextSection.name,4)
'**************************************************************************
'** Interdiction du supprimer le 1ier article *****************************
if NumArticle="0001" then
msgbox "La suppression du 1ier article n'est pas autorisée !",48
exit sub
end if
'**************************************************************************
'** Test si le N° d'article est valide ************************************
if NumArticle>"9999" or NumArticle<"0001" then
msgbox "La sélection en cours ne contient pas d'article !",48
exit sub
end if
'**************************************************************************
if (msgbox ("Supprimer l'article " & NumArticle, 4+48+256) = 6) then
oCursor = oDoc.Text.createTextCursor()
'** Déplacement au dessus de la premiere section de l'article *************
oSection=oDoc.GetTextSections.GetByName("<xml:article> " & NumArticle)
oCursor.gotoRange(oSection.Anchor.Start, FALSE)
oCursor.gotoPreviousParagraph(FALSE) 'Déplacement au début du paragraphe précédent
oCursor.gotoPreviousParagraph(FALSE) 'Déplacement au début du paragraphe précédent
oCursor.gotoStartOfParagraph(FALSE) 'Déplacement au début du paragraphe précédent
'**************************************************************************
'** Déplacement en dessous de la dernière section de l'article ************
oCursor.gotoRange(oSection.Anchor.End, TRUE)
oCursor.gotoNextParagraph(TRUE) 'Déplacement au début du paragraphe précédent
'**************************************************************************
'** Suppression de la selection précédente et donc de l'article ***********
oCursor.setString("")
'**************************************************************************
end if
end sub
Je voudrais me servir d'une macro semblable pour ajouter ou supprimer des clients dans mon formulaire mais j'ai beau essayer je n'y arrive pas. J'arrive à changer le nom de la section principale mais pas celui de la sous section <xml:article>. Une fois que je la renomme en <xml:client> la première section se renomme bien <xml:client>0001 mais la deuxième devient "section1" Pourquoi?
Comment faire pour changer la sous section <xml:article> en <xml:client> et qu'elle se renomme bien après? où est-il impossible de la renommer? J'ai un peu difficile à le croire.
Quelqu'un aurait-il une idée? merci.
Françoise
| 