Exemplariser un lot de notices

Préalable : extraire les données de la base pour générer MonTableau.

Dim etiquette
Dim Code_barre, Salle, Cote, PEB, Note
Dim RBC
'La Garde
RBC = "830622101"

Dim MonTableau(4,5)
MonTableau(0,0) = "001693522"
MonTableau(0,1) = "0260983303"
MonTableau(0,2) = "Espace Lettres"
MonTableau(0,3) = "870 SEN"
MonTableau(0,4) = "u"
MonTableau(0,5) = ""
MonTableau(1,0) = "048649422"
MonTableau(1,1) = "0260982801"
MonTableau(1,2) = "Espace Lettres"
MonTableau(1,3) = "880 LYS"
MonTableau(1,4) = "u"
MonTableau(1,5) = ""
MonTableau(2,0) = "061195928"
MonTableau(2,1) = "0261013795"
MonTableau(2,2) = "Espace Lettres"
MonTableau(2,3) = "870 SEN"
MonTableau(2,4) = "u"
MonTableau(2,5) = ""
MonTableau(3,0) = "012117404"
MonTableau(3,1) = "0261025187"
MonTableau(3,2) = "Espace Lettres"
MonTableau(3,3) = "870 CIC"
MonTableau(3,4) = "u"
MonTableau(3,5) = ""
MonTableau(4,0) = "001384686"
MonTableau(4,1) = "0260949415"
MonTableau(4,2) = "Espace Lettres"
MonTableau(4,3) = "880 LIB"
MonTableau(4,4) = "u"
MonTableau(4,5) = ""


Sub ChercheNbreExemplaires()
Dim ekzemplero
ekzemplero = 1
etiquette = "e0" & ekzemplero
Do Until Application.activeWindow.title.find (etiquette & " $a") = False
	ekzemplero = ekzemplero + 1
	If ekzemplero < 10 Then 
		etiquette = "e0" & ekzemplero
	Else
		etiquette = "e" & ekzemplero
	End If
Loop
Application.activeWindow.title.endOfBuffer
Application.activeWindow.simulateIBWKey "FE"
InsereExemplaire
End Sub

Sub DSI()
Dim I
For I = 0 to Ubound(MonTableau)
	Code_barre = MonTableau(I, 1)
	Salle = MonTableau(I, 2)
	Cote = MonTableau(I, 3)
	PEB = MonTableau(I, 4)
	Note = MonTableau(I, 5)
	Application.ActiveWindow.Command "che ppn " & MonTableau(I, 0), False
	Application.activeWindow.command "mod", False
	ChercheNbreExemplaires
Next
End Sub

Sub InsereExemplaire()
Application.ActiveWindow.NoviceMode False
Application.ActiveWindow.Command "cre " & etiquette, False
Application.ActiveWindow.Title.InsertText etiquette & " $bx" & vbCrLf
Application.ActiveWindow.Title.InsertText "915 ##$b" & Code_barre & vbCrLf
If Note = "" Then
	Application.ActiveWindow.Title.InsertText "930 ##$b" & RBC & "$d" & Salle & "$a" & Cote & "$j" & PEB & vbCrLf
Else
	Application.ActiveWindow.Title.InsertText "930 ##$b" & RBC & "$d" & Salle & "$a" & Cote & "$j" & PEB & "$v" & Note & vbCrLf
End If
Application.ActiveWindow.SimulateIBWKey "FR"
End Sub

Ce script lance une recherche sur chaque PPN (MonTableau(I, 0)) et insère les données d'exemplaire.