Option Explicit
' les sélections de chaque ListBox sont enregistrées dans une variable de document
' Eventuellement renommer les listBox pour que le code soit cohérent et facile à lire.
Const nomVar1 = "ListBox1" ' nom de la variable 1
Const nomVar2 = "ListBox2" ' nom de la variable 2
Const nomVar3 = "ListBox3" ' nom de la variable 3
Const nomVar4 = "ListBox4" ' nom de la variable 4

Private Sub valeursListeBox1()
Dim tabSel As String
Dim i As Long
ListBox1.MultiSelect = fmMultiSelectMulti
ListBox1.Clear  ' Efface le contenu actuel
' ADAPTER --------------------------------------------------------------------------------
ListBox1.AddItem "A1 - Roche et autres substrats durs intertidaux"
ListBox1.AddItem "A2 - Sédiment intertidal"
ListBox1.AddItem "A3 - Roche et autres substrats durs infralittoraux"
ListBox1.AddItem "A4 - Roche et autres substrats durs circalittoraux"
ListBox1.AddItem "A5 - Sédiment subtidal"

tabSel = LireVariable1()
tabSel = Left(tabSel & "000000000000000000000000000000", ListBox1.ListCount)
' activer la sélection pour ceux qui doivent l'être (mémorisées dans la variable)
For i = 1 To ListBox1.ListCount
  If Mid(tabSel, i, 1) = "1" Then ListBox1.Selected(i - 1) = True
Next

End Sub

Private Sub valeursListeBox2()
Dim tabSel As String
Dim i As Long
ListBox2.MultiSelect = fmMultiSelectMulti
ListBox2.Clear  ' Efface le contenu actuel
' ADAPTER --------------------------------------------------------------------
ListBox2.AddItem "B1 - "
ListBox2.AddItem "B2 - "
ListBox2.AddItem "B3 - "
ListBox2.AddItem "B4 - "
ListBox2.AddItem "B5 - "
ListBox2.AddItem "B6 - "

tabSel = LireVariable2()
tabSel = Left(tabSel & "000000000000000000000000000000", ListBox2.ListCount)
' activer la sélection pour ceux qui doivent l'être (mémorisées dans la variable)
For i = 1 To ListBox2.ListCount
  If Mid(tabSel, i, 1) = "1" Then ListBox2.Selected(i - 1) = True
Next

End Sub

Private Sub valeursListeBox3()
' Supprimer tout le contenu du Sub si ListBox 3  n'existe pas
Dim tabSel As String
Dim i As Long
ListBox3.MultiSelect = fmMultiSelectMulti
ListBox3.Clear  ' Efface le contenu actuel
' ADAPTER --------------------------------------------------------------------
ListBox3.AddItem "C1 - "
ListBox3.AddItem "C2 - "
ListBox3.AddItem "C3 - "
ListBox3.AddItem "C4 - "
ListBox3.AddItem "C5 - "
ListBox3.AddItem "C6 - "
ListBox3.AddItem "C7 - "

tabSel = LireVariable3()
tabSel = Left(tabSel & "000000000000000000000000000000", ListBox3.ListCount)
' activer la sélection pour ceux qui doivent l'être (mémorisées dans la variable)
For i = 1 To ListBox3.ListCount
  If Mid(tabSel, i, 1) = "1" Then ListBox3.Selected(i - 1) = True
Next
End Sub

Private Sub valeursListeBox4()
' Supprimer tout le contenu du Sub si ListBox 4  n'existe pas
Dim tabSel As String
Dim i As Long
ListBox4.MultiSelect = fmMultiSelectMulti
ListBox4.Clear  ' Efface le contenu actuel
' ADAPTER --------------------------------------------------------------------
ListBox4.AddItem "D1 - "
ListBox4.AddItem "D2 - "
ListBox4.AddItem "D3 - "

tabSel = LireVariable4()
tabSel = Left(tabSel & "000000000000000000000000000000", ListBox4.ListCount)
' activer la sélection pour ceux qui doivent l'être (mémorisées dans la variable)
For i = 1 To ListBox4.ListCount
  If Mid(tabSel, i, 1) = "1" Then ListBox4.Selected(i - 1) = True
Next

End Sub


Private Sub Document_Open()
'Ouverture du document : remplir les list box
Call valeursListeBox1
Call valeursListeBox2
Call valeursListeBox3
Call valeursListeBox4

End Sub


Private Sub Document_Close()
' Fermeture du document : écriture des variables de mémorisation
Call EcrireVariable1
Call EcrireVariable2
Call EcrireVariable3
Call EcrireVariable4

End Sub

Private Function LireVariable1() As String
' lit la variable 1
Dim var As Variant
For Each var In ActiveDocument.Variables
  If var.Name = nomVar1 Then
    LireVariable1 = var.Value
    Exit Function
  End If
Next var
LireVariable1 = ""
End Function

Private Function LireVariable2() As String
' lit la variable 2
Dim var As Variant
For Each var In ActiveDocument.Variables
  If var.Name = nomVar2 Then
    LireVariable2 = var.Value
    Exit Function
  End If
Next var
LireVariable2 = ""
End Function

Private Function LireVariable3() As String  '   A dupliquer
' lit la variable 3
Dim var As Variant
For Each var In ActiveDocument.Variables
  If var.Name = nomVar3 Then
    LireVariable3 = var.Value
    Exit Function
  End If
Next var
LireVariable3 = ""
End Function

Private Function LireVariable4() As String
' lit la variable 4
Dim var As Variant
For Each var In ActiveDocument.Variables
  If var.Name = nomVar4 Then
    LireVariable4 = var.Value
    Exit Function
  End If
Next var
LireVariable4 = ""
End Function
'================================================
Private Sub EcrireVariable1()
' Ecrit la variable 1
Dim i As Long
Dim var
Dim r As String
r = ""
For i = 1 To ListBox1.ListCount
  If ListBox1.Selected(i - 1) = True Then
    r = r & "1"
  Else
    r = r & "0"
  End If
Next
For Each var In ActiveDocument.Variables
  If var.Name = nomVar1 Then
   var.Value = r
    Exit Sub
  End If
Next var
ActiveDocument.Variables.Add Name:=nomVar1, Value:=r
End Sub

Private Sub EcrireVariable2()
' Ecrit la variable 2
Dim i As Long
Dim var
Dim r As String
r = ""
For i = 1 To ListBox2.ListCount
  If ListBox2.Selected(i - 1) = True Then
    r = r & "1"
  Else
    r = r & "0"
  End If
Next
For Each var In ActiveDocument.Variables
  If var.Name = nomVar2 Then
   var.Value = r
    Exit Sub
  End If
Next var
ActiveDocument.Variables.Add Name:=nomVar2, Value:=r
End Sub

Private Sub EcrireVariable3()
' Ecrit la variable 3
Dim i As Long
Dim var
Dim r As String
r = ""
For i = 1 To ListBox3.ListCount
  If ListBox3.Selected(i - 1) = True Then
    r = r & "1"
  Else
    r = r & "0"
  End If
Next
For Each var In ActiveDocument.Variables
  If var.Name = nomVar3 Then
   var.Value = r
    Exit Sub
  End If
Next var
ActiveDocument.Variables.Add Name:=nomVar3, Value:=r
End Sub

Private Sub EcrireVariable4()
' Ecrit la variable 4
Dim i As Long
Dim var
Dim r As String
r = ""
For i = 1 To ListBox4.ListCount
  If ListBox4.Selected(i - 1) = True Then
    r = r & "1"
  Else
    r = r & "0"
  End If
Next
For Each var In ActiveDocument.Variables
  If var.Name = nomVar4 Then
   var.Value = r
    Exit Sub
  End If
Next var
ActiveDocument.Variables.Add Name:=nomVar4, Value:=r
End Sub