suivi des revisions

[nicolas_151]

Bonjour je voudrais savoir si quelqu'un s'y connais en Visio Vba

avec Visio on peut mettre un suivi des révisions

ce code permet de passer en mode révision

ActiveWindow.Document.DocumentSheet.Cells("AddMarkup").Result(0) = True

et celui-ci permet de savoir si il y a des calque de révision sur la page

    Dim vsoPage As Visio.Page
    Dim intCounter As Integer
 
    Set vsoPage = ActivePage
    
    If vsoPage.Type = visTypeMarkup Then
                
        For intCounter = 0 To vsoPage.Document.DocumentSheet.RowCount(visSectionReviewer) - 1
        
            If vsoPage.ReviewerID = vsoPage.Document.DocumentSheet.CellsSRC(visSectionReviewer, visRowReviewer + intCounter, visReviewerReviewerID).ResultStr(0) Then
            
                MsgBox "Revision active est : " & vsoPage.Document.DocumentSheet.CellsSRC(visSectionReviewer, visRowReviewer + intCounter, visReviewerName).ResultStr(0)
            Else
                MsgBox "Revision passive est : " & vsoPage.Document.DocumentSheet.CellsSRC(visSectionReviewer, visRowReviewer + intCounter, visReviewerName).ResultStr(0)
            End If
            
         Next intCounter
        
    Else
    
        MsgBox "pas de révisions dans cette page."
        
    End If

même si les calques de révision existe on ne peut pas y accéder tant que au moins 1 objet est introduit dans le calque

Comment faire pour introduire le premier objet dans le calque pour y avoir accès?
autrement dit comment faire pour réutiliser les anciens calque?

sachant que manuellement on ajoute un seul calque, c'est pourquoi il faut modifier dans les paramètres le nom de l'utilisateur et ses initials pour ajouter un autre calque

Merci pour vos conseille

[nicolas_151]

Bonjour tous le monde

J'ai trouver la réponse a ma question
Pour pouvoir réutilise un calque de révision il faut mettre dans les paramètre avancé le nom et les initiales du calque

dans le code VBA sa donne cela

Doc.Application.UserName = "Nom"
  Doc.Application.Settings.UserInitials = "Initial"
  ActiveWindow.Document.DocumentSheet.Cells("AddMarkup").Result(0) = True
 'dessin pour garder le calque
  Set vsoShape = ActivePage.DrawRectangle(1, 4, 1, 4)