Modifier la localisation sur un lot de codes-barres

Sub ModifieLocalisationCodeBarre()
	Const NouveauFonds = "$dEspace Sciences"
	Dim CodeBarre, Chaine, NouvelleChaine, Localisation, PositionDollar_a, PositionDollar_d
	Dim LesCodesBarres
	LesCodesBarres = Array("0260410250","0260411776","0260411783")
	For Each CodeBarre In LesCodesBarres
		Application.ActiveWindow.Command "che cod " & CodeBarre
		If Application.ActiveWindow.Messages.Count = 0 Then
			Application.ActiveWindow.Command "mod", False
			Dim TrouveCodeBarre
			TrouveCodeBarre = Application.ActiveWindow.Title.Find(CodeBarre, True, False, False)
			If TrouveCodeBarre = True Then
				Application.ActiveWindow.Title.LineDown()
				Application.ActiveWindow.Title.StartOfField()
				If Application.ActiveWindow.Title.tag = "930" Then
					Chaine = Application.ActiveWindow.Title.currentField
					PositionDollar_d = InStr(Chaine, "$d")
					PositionDollar_a = InStr(Chaine, "$a")
					Localisation = Mid(Chaine, PositionDollar_d, (PositionDollar_a - PositionDollar_d))
					NouvelleChaine = Replace(Chaine, Localisation, NouveauFonds)		
					Application.ActiveWindow.Title.InsertText(NouvelleChaine)
					Application.ActiveWindow.Title.deleteToEndOfLine
					Application.activeWindow.simulateIBWKey "FR"
				End If
			End If
		Else
			InputBox "Problème", "Problème", Application.ActiveWindow.Messages.item(0) & ":" & CodeBarre & ":" & Application.ActiveWindow.Variable("P3GPP")
		End If
	Next
End Sub

Noter l'astuce pour remplacer une ligne : on se met en début de ligne (en l'occurrence on y est déjà), on insère la nouvelle ligne (le curseur se retrouve à la fin de la chaîne insérée), puis on détruit toute la fin (qui est l'ancienne ligne).

Ajouter une localisation sur un lot de codes-barres

Dans ce cas on a un 930 sans $d, mais avec un $a. il suffit donc de remplacer la chaîne "$a" par <nouvelle localisation>$a

Sub AjouteLocalisationCodeBarre()
	Const NouveauFonds = "$dRevues$a"
	Dim CodeBarre, Chaine, NouvelleChaine, Localisation, PositionDollar_a
	Dim LesCodesBarres
	LesCodesBarres = Array("0261536645","0261536607","0261536638","0261186901","0261140675")
	For Each CodeBarre In LesCodesBarres
		Application.ActiveWindow.Command "che cod " & CodeBarre
		If Application.ActiveWindow.Messages.Count = 0 Then
			Application.ActiveWindow.Command "mod", False
			Dim TrouveCodeBarre
			TrouveCodeBarre = Application.ActiveWindow.Title.Find(CodeBarre, True, False, False)
			If TrouveCodeBarre = True Then
				Application.ActiveWindow.Title.LineDown()
				Application.ActiveWindow.Title.StartOfField()
				If Application.ActiveWindow.Title.tag = "930" Then
					Chaine = Application.ActiveWindow.Title.currentField
					PositionDollar_a = InStr(Chaine, "$a")
					Localisation = Mid(Chaine, PositionDollar_a, 2)
					NouvelleChaine = Replace(Chaine, Localisation, NouveauFonds)
					Application.ActiveWindow.Title.InsertText(NouvelleChaine)
					Application.ActiveWindow.Title.deleteToEndOfLine
					Application.activeWindow.simulateIBWKey "FR"
				End If
			End If
		Else
			InputBox "Problème", "Problème", Application.ActiveWindow.Messages.item(0) & ":" & CodeBarre & ":" & Application.ActiveWindow.Variable("P3GPP")
		End If
	Next
End Sub

Effacer une sous-localisation à partir d'un lot de codes-barres

Sub EffaceSousLocalisationCodeBarre()
	Dim CodeBarre, Chaine, NouvelleChaine, Localisation, PositionDollar_a, PositionDollar_e
	Dim LesCodesBarres
	LesCodesBarres = Array("0261224696","0261224658","0261224672","0261224634","0261224702","0261225181","0261225051","0261225129","0261225105","0261225112","0261225068","0261225136","0261225143","0261225075","0261225013","0261225020","0261224986","0261224900","0261224993","0261224979","0261225082","0261225099","0261224962","0261225044","0261225006","0261225037","0261224955","0261224917","0261224948","0261212648","0261068306","0261068351	CNL Amerique hispanique","0261068443","0261068375","0261068337","0261068320","0261068344	CNL Amerique hispanique","0261068436","0261068498","0261068313","0261068399","0261068474","0261068405","0261068290","0261068467","0261068481","0261068382","0261068450","0261068368	CNL Amerique hispanique","0261212631","0261068412","0261068634","0261068429","0261068641","0261068627	CNL Amerique hispanique","0261068559","0261068719","0261068733","0261068573","0261068764","0261068702","0261068566","0261068726","0261068696","0261068870","0261068689","0261068580","0261068603","0261068856","0261068658","0261068832","0261068757","0261068610","0261068863","0261212655","0261068542","0261068535","0261068887","0261068849","0261068740","0261068597","0261068672","0261068665","0261257175","0261068788","0261068795","0261068801","0261068825","0261068986","0261068931","0261068818","0261069006","0261068924","0261068771","0261068955","0261068894","0261068948","0261068917","0261068993","0261068900","0261068979","0261068962","0261213195","0261212730","0261257236","0261213171","0261257496","0261069150","0261069143","0261069136","0261257281","0261251241","0261256673","0261256987","0261256932","0261254655","0261251227","0261257243","0261261783","0261251265")
	For Each CodeBarre In LesCodesBarres
		Application.ActiveWindow.Command "che cod " & CodeBarre
		If Application.ActiveWindow.Messages.Count = 0 Then
			Application.ActiveWindow.Command "mod", False
			Dim TrouveCodeBarre
			TrouveCodeBarre = Application.ActiveWindow.Title.Find(CodeBarre, True, False, False)
			If TrouveCodeBarre = True Then
				Application.ActiveWindow.Title.LineDown()
				Application.ActiveWindow.Title.StartOfField()
				If Application.ActiveWindow.Title.tag = "930" Then
					Chaine = Application.ActiveWindow.Title.currentField
					PositionDollar_e = InStr(Chaine, "$e")
					PositionDollar_a = InStr(Chaine, "$a")
REM Au cas où l'on n'aurait pas de 930$a
					If PositionDollar_a > 0 Then
						Localisation = Mid(Chaine, PositionDollar_e, (PositionDollar_a - PositionDollar_e))
						NouvelleChaine = Replace(Chaine, Localisation, "")
						Application.ActiveWindow.Title.InsertText(NouvelleChaine)
						Application.ActiveWindow.Title.deleteToEndOfLine
					Else
						PositionDollar_a = InStr(Chaine, "$j")
						Localisation = Mid(Chaine, PositionDollar_e, (PositionDollar_a - PositionDollar_e))
						NouvelleChaine = Replace(Chaine, Localisation, "")
						Application.ActiveWindow.Title.InsertText(NouvelleChaine)
						Application.ActiveWindow.Title.deleteToEndOfLine
					End If
					Application.activeWindow.simulateIBWKey "FR"
				End If
			End If
		Else
			InputBox "Problème", "Problème", Application.ActiveWindow.Messages.item(0) & ":" & CodeBarre & ":" & Application.ActiveWindow.Variable("P3GPP")
		End If
	Next
End Sub