[VBscript] hyperlink dans excel

shotokan -  
 Lupin -
Je cherche a lister tous les liens vers d'autres fichiers pour un fichier excel passer un argument, a priori pas complique mais j'ai commence le VBscript y a 3 jours :sweat: . J'appelle le programme via un cmd qui lui lance tous les xls de certains repertoires suivants certains criteres.

Avec Word, j'ai pas eu de probleme :bounce: , mais avec excel :kaola: :
j'ai des messages indiquant parfois des modifications de liens entre classeur (voulez vous mettre a jour..., je clique non mais je ne sais pas si l'extraction fonctionne correctement par la suite), alors que j'ai mis objexcel.DisplayAlerts=False.

En plus je recherche que dans 1 worksheet, y a t il un moyen d'avoir le nombre de feuille via une commande afin de faire ensuite un do while ... loop

Ci dessous le code si vous pouvez m'aider a corriger les bugs, merci bcp de m'aider


'declaration des variables
Dim nomFichier, objExcel, resultatxls, args, link,Process, ProcessSet
ProcessName="Excel.exe"

'On verifie s il y a bien l argument de la fonction qui est le nom du fichier
Set args = Wscript.Arguments
If args.count=0 Then
WScript.Echo "il manque les parametres"
WScript.quit 'on sort du vbs si pas d argument
else
nomFichier=args(0)
end if

'Definition du fichier resultat
resultatxls="C:\Documents and Settings\users\Mes documents\resultatxls.txt"

'Ouverture des applications
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False 'on n affiche pas excel
objExcel.DisplayAlerts = False 'on desactive les alarmes

'ouverture du fichier de resultat
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFilexls = objFSO.CreateTextFile(resultatxls)

'ouverture du fichier Excel
Set objWorkbook = objExcel.WorkBooks.Open(nomFichier) ' on ouvre le fichier voulu
Set objWorksheet = objExcel.Worksheets(1) ' on prend la feuille excel 1
objWorksheet.Activate ' on l active

'recherche des hyperlinks non vide et copie dans le fichier de resultat
Set colHyperlinks = objWorkSheet.Hyperlinks ' on prend tous les liens de la feuille
For Each objHyperlink in colHyperlinks ' pour chaque lien non vide on le copie dans le fichier
if not (objHyperlink.Address="") then
objFilexls.WriteLine chr(34) & objHyperlink.Address & Chr(34) & " ; " & objHyperlink.TextToDisplay
end if
Next


'fermeture des ressources
objFilexls.Close
objworkbook.Close
objExcel.Quit

'kill de excel s'il reste ouvert en arriere plan
Set shell = WScript.CreateObject("WScript.Shell")
Set ProcessSet=GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Computer).InstancesOf _
("Win32_process")
for each Process in ProcessSet
If InStr(1,Process.Name, ProcessName, vbTextCompare)>0 Then
result=Process.terminate(0)
end if
Next
Wscript.quit
A voir également:

3 réponses

Réponse 1 / 3
Lupin
 
Bonjour,

voilà, j'ai apporté quelques modifications ! 

'-----------------------------------------------------------------------------------
'Déclaration des variables
Dim nomFichier, objExcel, objReseau, Resultatxls, Args, Link, Process, ProcessSet
Dim ProcessName, Ordinateur

'On verifie s il y a bien l argument de la fonction qui est le nom du fichier
Set args = Wscript.Arguments

If args.count=0 Then
	WScript.Echo "il manque les parametres"
Else
	ProcessName="Excel.exe"
	nomFichier=args(0)

	'Definition du fichier resultat
	resultatxls="C:\Documents and Settings\sigmb12\Bureau\resultatxls.txt"

	'Ouverture des applications
	Set objExcel = CreateObject("Excel.Application")
	objExcel.Visible = False 'on n affiche pas excel
	objExcel.DisplayAlerts = False 'on desactive les alarmes
	objExcel.ScreenUpdating = False 'on désactive le rafraichissement d'ecran

	'ouverture du fichier de resultat
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set objFilexls = objFSO.CreateTextFile(resultatxls)

	'ouverture du fichier Excel
	Set objWorkbook = objExcel.WorkBooks.Open(nomFichier) ' on ouvre le fichier voulu
'	Set objWorksheet = objExcel.Worksheets(1) ' on prend la feuille excel 1

	For Each objWorksheet In objExcel.Worksheets
'		WScript.Echo objWorksheet.Name
 		'recherche des hyperlinks non vide et copie dans le fichier de resultat
		Set colHyperlinks = objWorkSheet.Hyperlinks ' on prend tous les liens de la feuille

		For Each objHyperlink in colHyperlinks ' pour chaque lien non vide on le copie dans le fichier
			If Not (objHyperlink.Address="") then
				objFilexls.WriteLine chr(34) & objHyperlink.Address & Chr(34) & " ; " & objHyperlink.TextToDisplay
			End if
		Next
	Next

	objExcel.ScreenUpdating = True 'on réactive le rafraichissement d'ecran
	objExcel.DisplayAlerts = True 'on réactive les alarmes

	'fermeture des ressources
	objFilexls.Close
	objworkbook.Close
	objExcel.Quit

	'kill de excel s'il reste ouvert en arriere plan
	Set objReseau  = CreateObject("WScript.Network")
	Ordinateur = LCase(objReseau.ComputerName)
	Set ProcessSet=GetObject("winmgmts:{impersonationLevel=impersonate}!//" & Ordinateur).InstancesOf _
	("Win32_process")
	For Each Process in ProcessSet
		If (InStr(1,Process.Name, ProcessName, vbTextCompare) > 0) Then
			result=Process.terminate(0)
		End If
	Next
End if

Wscript.quit


Lupin
0
Réponse 2 / 3
shotokan
 
Merci bcp :))
0
Réponse 3 / 3
Lupin
 
re:

j'ai oublié de libérer les inititeurs !

le final du code : 
                                     End If
	Next
End if

Wscript.quit


devient 

		End If
	Next
	Set args = Nothing
	Set objExcel = Nothing
	Set objFSO = Nothing
	Set objFilexls = Nothing
	Set objWorkbook = Nothing
	Set colHyperlinks = Nothing
	Set objReseau  = Nothing
End if

Wscript.quit


Lupin
0