Fonction range inconnue
Bonjour, je dois débugger un fichier VBA qui a été fait par quelqu'un d'autre mais qui n'est plus là. Il a. dans son fichier, utilisé une fonction avec "Range" que je ne connais pas et que je n'arrive pas à comprendre.
Voilà la fonction (partielle):
j = 89
ActiveWorkbook.Worksheets("feuille1").Range("E" & j).Value
Je comprend que le "j" vaut 89 mais à quoi il sert dans cette fonction? Est-ce que ça veut dire qu'il part du range(E:89)? J'ai fait des recherche, essayé plein de chose mais je ne comprends pas à quoi ça sert. Il utilise cela abondamment dans la macro mais lorsque je regarde le résultat, ça ne semble rien apporter d'utile.
ex: for i = 9 to 2864
activesheet.range("AG" & i),value me retourne la valeur de AG mais rien de plus, est-ce que c'est parce que la macro ne fonctionne plus?
Merci de m'aider si vous le pouvez. J'espère que c'est clair comme explication. Sinon, je vais essayer de mieux expliquer le problème.
Bonsoir,
peux-tu mettre le code ? et nous indiquer ce qu'il est censé faire ?
Bonjour, le code est très long. Je peux en mettre une partie mais je ne suis pas certain que cela sera utile sans le fichier et je ne peux pas mettre le fichier. Pour ce qu'il est supposé faire, il est supposé créer des répertoires avec leurs noms, créer des raccourcis sur le bureau et d'autre chose que je ne comprends pas encore tout à fait. Selon moi, il y a beaucoup trop de variable qui ne servent absolument à rien. Les notes ont été mise par moi.
merci
Voilà la macro:
Sub Creation()
Dim Reponse As Variant
Dim i As Integer
Dim j As Integer
Dim DestinationSubDossier
Dim DestinationSubDossierLM
Dim DestinationSubDossierVT
Dim DestinationSubDossier2
Dim ZSubDossier2
Dim DestinationSubDossier3
Dim NumJob
Dim NumBT
Dim NumName
Dim NumDraw
Dim Num1
Dim NumAlpha
Dim NumSheet
Dim NumProjet As String
Dim NumSoum
Dim Name
Dim Num1Projet
Dim Folder1Name
Dim lng
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")
Dim MyShortcut As Object
Dim ZPath As String
Dim JPath As String
Dim FSOobj As Object
Set FSOobj = CreateObject("Scripting.FilesystemObject")
Sheets("feuille14").Activate 'Sélectionne la feuille "feuille14"
NumProjet = ActiveSheet.Range("AG7").Value 'Donne la valeur de la cellule "AG7", le BT
NumSoum = ActiveSheet.Range("G4").Value 'Donne la valeur de la cellule "G4", le numéro de la soumission
Name = ActiveSheet.Range("C2").Value 'Donne la valeur de la cellule "C2", nom du client
lng = Len(NumProjet) 'donne le nombre de caractère (5)
Num1 = Mid(NumProjet, 2, lng - 3) 'donne 2 caractère
Num1Projet = Mid(NumProjet, 2) 'donne les 2 premier caractères
Folder1Name = Num1Projet & " " & Name & " " & NumSoum 'créer le nom du répertoire
ZPath = Mid(ActiveWorkbook.Path, 1, Len(ActiveWorkbook.Path) - 10) 'donne le nonm du répertoire moins 10 lettres
DestinationSubDossier = "Z:\COMMANDE " & Num1 & "00-" & Num1 & "99\" & Folder1Name
If FSOobj.FolderExists(DestinationSubDossier) = False Then
FSOobj.CreateFolder DestinationSubDossier
End If
DestinationSubDossierLM = DestinationSubDossier & "\" & NumProjet & " LIVRE DE MAINTENANCE"
If FSOobj.FolderExists(DestinationSubDossierLM) = False Then
FSOobj.CreateFolder DestinationSubDossierLM
End If
DestinationSubDossierVT = DestinationSubDossier & "\" & NumProjet & " VÉRIFICATION TECHNIQUE"
If FSOobj.FolderExists(DestinationSubDossierVT) = False Then
FSOobj.CreateFolder DestinationSubDossierVT
End If
j = 89
Do Until ActiveWorkbook.Worksheets("feuille1").Range("E" & j).Value <> "0"
j = j - 1
Loop
ActiveWorkbook.Worksheets("feuille1").PageSetup.TopMargin = Application.InchesToPoints(0.75)
ActiveWorkbook.Worksheets("feuille1").PageSetup.Orientation = xlPortrait
ActiveWorkbook.Worksheets("feuille1").PageSetup.PrintArea = "C1:I" & j
ActiveWorkbook.Worksheets("feuille1").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestinationSubDossierLM & "\C-" & NumProjet & "-TableMatière.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Worksheets("feuille2").PageSetup.TopMargin = Application.InchesToPoints(0.75)
With ActiveWorkbook.Worksheets("Sfeuille2").PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
ActiveWorkbook.Worksheets("feuille2").PageSetup.PrintArea = "B3:I45"
ActiveWorkbook.Worksheets("feuille2").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestinationSubDossierLM & "\A-" & NumProjet & "-Cover.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
If ActiveSheet.Range("F4").Value = "Français" Then
FileCopy "Z:\Maintenance Template\B-TEMPLATE_FR.pdf", DestinationSubDossierLM & "\B-TEMPLATE_FR.pdf"
End If
If ActiveSheet.Range("F4").Value = "Anglais" Then
FileCopy "Z:\Maintenance Template\B-TEMPLATE_EN.pdf", DestinationSubDossierLM & "\B-TEMPLATE_EN.pdf"
End If
For i = 9 To 2864
'For i = 9 To 100
If ActiveSheet.Range("AK" & i).Value <> "" Then
NumJob = ActiveSheet.Range("AG" & i).Value
MsgBox NumJob
NumBT = ActiveSheet.Range("AH" & i).Value
MsgBox NumBT
NumAlpha = 65
numitem = ActiveSheet.Range("A" & i).Value
MsgBox numitem
NumSheet = ActiveSheet.Range("AJ" & i).Value
MsgBox NumSheet
NumName = ActiveWorkbook.Worksheets("# (" & NumSheet & ")").Range("C5").Value
NumDraw = ActiveWorkbook.Worksheets("# (" & NumSheet & ")").Range("CL6").Value
DestinationSubDossier2 = DestinationSubDossier & "\" & NumJob & " " & NumName & " (" & numitem & ") BT " & NumBT
ZSubDossier2 = ZPath & "Gérance Projet\ingénierie\" & NumJob & " " & NumName & " (" & numitem & ") BT " & NumBT
If FSOobj.FolderExists(DestinationSubDossier2) = False Then
FSOobj.CreateFolder DestinationSubDossier2
End If
If FSOobj.FolderExists(ZSubDossier2) = False Then
FSOobj.CreateFolder ZSubDossier2
End If
' Create a shortcut object on the desktop
Set MyShortcut = WSHShell.CreateShortcut(DestinationSubDossier2 & "\Z" & NumJob & " " & NumName & ".lnk")
' Set shortcut object properties and save it
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(ZSubDossier2)
MyShortcut.WindowStyle = 4
MyShortcut.Save
' Create a shortcut object on the desktop
Set MyShortcut = WSHShell.CreateShortcut(ZSubDossier2 & "\" & NumJob & " " & NumName & ".lnk")
' Set shortcut object properties and save it
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(DestinationSubDossier2)
MyShortcut.WindowStyle = 4
MyShortcut.Save
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").PageSetup.TopMargin = Application.InchesToPoints(0.75)
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").PageSetup.PrintArea = "AW1:BD48"
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestinationSubDossierVT & "\" & NumJob & "-VT.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").PageSetup.PrintArea = "A1:AN48"
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestinationSubDossierLM & "\" & NumJob & "-FT.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").PageSetup.PrintArea = "A1:" & Drawing(NumDraw) & "48"
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestinationSubDossier2 & "\" & NumJob & " FICHE_TECHNIQUE.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
If NumDraw <> 0 Then
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").PageSetup.PrintArea = "CS1:" & Drawing(NumDraw) & "48"
ActiveWorkbook.Worksheets("# (" & NumSheet & ")").ExportAsFixedFormat Type:=xlTypePDF, Filename:=DestinationSubDossier2 & "\" & NumJob & " DRAWING_INSTRUCTION.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Sheets("T&M").Activate
ElseIf ActiveSheet.Range("AP" & i).Value <> "" Then
NumBT = ActiveSheet.Range("AH" & i).Value
NumName = ActiveSheet.Range("E" & i).Value
DestinationSubDossier3 = DestinationSubDossier2 & "\" & NumJob & Chr(NumAlpha) & " " & NumName & " BT " & NumBT
NumAlpha = NumAlpha + 1
If FSOobj.FolderExists(DestinationSubDossier3) = False Then
FSOobj.CreateFolder DestinationSubDossier3
End If
End If
Next i
End Sub
Bonsoir,
je suppose que tu as l'erreur au niveau de ces instructions.
il s'agit d'une boucle qui examine les cellules en colonne "E" à partir de la ligne 89 et en soustrayant 1 tant que la valeur trouvée en colonne E dans la ligne J contient le caractère "0". à un moment j vaut zéro faisant référence à la cellule E0 (range "E" & j) qui n'existe pas d'où l'erreur.
j = 89
Do Until ActiveWorkbook.Worksheets("feuille1").Range("E" & j).Value <> "0"
j = j - 1
Looptu pourrais modifier ce code de la manière suivante (sans garantie pour la suite du traitement, ne disposant pas des données.
j = 89
Do Until ActiveWorkbook.Worksheets("feuille1").Range("E" & j).Value <> "0" or j=1
j = j - 1
LoopBonjour, merci pour la réponse mais j'ai trouvé les problèmes.
1. Il y a une erreur dans la création d'un répertoire, il manque un \ et il ne crée pas les répertoires au bon endroit. C'est régler.
2. Il ne fait pas la boucle à la ligne "For i = 9 to 2864"
Il exécute la première ligne a la perfection mais lorsqu'il devrait refaire la boucle, il ne se passe rien.
Dans les lignes de "9 to 2864", il y a plusieurs items, donc il devrait créer des répertoires pour chaque item mais il ne fait rien, il n'arrive pas à créer les répertoires. Le fichier arrête là et donne un message d'erreur. Je ne comprend pas pourquoi ça ne fonctionne pas.
merci de votre aide.
Bonjour, j'ai trouvé le problème. Il y avait dans un des items un "/" dans le nom ce qui créait une impossibilité au niveau de la création des répertoires.
Merci de ton aide H2so4.