Subscript Error incompréhensible
Bonjour à tous,
voilà mon problèpme :
je suis en train de m'arracher les cheveux et je tiens à les garder
Plus sérieusement : j'ai une erreur subscript outof range lors de ma commande:
Code:
nbvar = Application.CountA(Workbooks(justname).Sheets(pipesheetsname).Range("b:b")) - 1
Ceci m'a fait penser à une erreur dans le nom utilisé pour le workbook ou la feuille.
J'ai du coup fait un code qui evite ce genre de pépin et rien de neuf... ça marche pas...
Donc c'est assez obscure pour moi car je vois pas le problème de mon code, peut etre que quelqu'un y verra plus clair.
en gros ma macro est toute bête
dans mon fichier A j'ai un bouton
il m'envoie à un fenêtre pour choisir mon fichier B qui contient les noms de mes modèles
je copie la ligne 3 (les noms) de mon fichier B dans la colonne "BA" de mon fichier A
je fais une validation dans une cellule de mon fichier A avec la collone BA
ou je pourrais du coup choisir un modèle parmi ceux que j'avais crée dans le fihcier B
suis -je clair ? non ? c pas surprenant je suis un grand incompris :mouarf:
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
|
Sub open_mypipefile()
Dim pipesheetsname, justname, pathfile, myworkbook, mypath As String
Dim i, nbvar As Integer, stfile As Variant
Dim test1, test2, temp As String
'
ThisWorkbook.Activate
myworkbook = ThisWorkbook.Name
mypath = ThisWorkbook.Path
pipesheetsname = "risers"
stfile = Application.GetOpenFilename("Pipe generation file (*.xls),*.xls", 3, "Choose your file", 0, False)
If stfile = False Then
End
End If
Range("BA1:BA37").ClearContents
Range("BA1").Value = stfile
Range("ba1").Replace what:="*\", replacement:=""
justname = Range("BA1").Value
pathfile = Mid(stfile, 1, Len(stfile) - Len(justname))
MsgBox pathfile & Chr(10) & mypath
If pathfile <> mypath Then
FileCopy stfile, mypath & "\" & justname
End If
ChDrive Mid(mypath, 1, 1)
ChDir mypath
nbvar = Application.CountA(Workbooks(justname).Sheets(pipesheetsname).Range("b:b")) - 1
For i = 1 To nbvar
temp = Workbooks(justname).Sheets(pipesheetsname).Cells(3, i + 1).Value
Workbooks(myworkbook).Sheets("Model").Cells(i + 1, 53) = temp
Next
With Workbooks(myworkbook).Sheets("Model").Range("i10").Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, _
Operator:=xlBetween, Formula1:="=$BA$2:$BA$" & nbvar
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = "For your own information"
.InputMessage = ""
.ErrorMessage = _
"Your pipe type may not be in your model" & Chr(10) & "This could make the batch to fail"
.ShowInput = True
.ShowError = True
End With
End Sub |
