Question sur la signification d'une ligne VBA
Bonjour, j'ai un problème quand je fais tourner ma macro, elle m'indique ceci dans le debug. J'aimerais comprendre ce qui ne va pas.
Sub CopyHeader()
' copy the heading
j = 1
Do Until j = 14
strData = Worksheets(srcSheet).Cells(1, j).Value
Worksheets(dstSheet).Cells(1, j).Value = strData
j = j + 1
Loop
Worksheets(dstSheet).Cells(1, 14).Value = "Day"
Worksheets(dstSheet).Cells(1, 15).Value = "Hours"
Worksheets(dstSheet).Cells(1, 16).Value = "Comment"
Rows("1:1").Select
Selection.Font.Bold = True
End SubEnfaite cette macro tournait sur un fichier que j'importais. Maintenant ce fichier est déjà importé, en tant que sheet "Xiotbmc 3!"
Je pense que ce n'est pas la bonne dénomination dans la macro du coup...
Merci de votre aide
Bonjour,
Sans voir ton fichier, on est réduit aux conjectures.
Solution la plus probable en l'état : la feuille srcSheet n'existe pas !
Quel est le numéro d'erreur ?
Run Time error '9' :
Subscript out of range
Comment nommé cette sheet sachant que ce ne sera pas toujours le meme nom car les fichiers importés seront différents ? ...
Le nom de la feuille ne correspond pas.
Il faut affecter le nom de la feuille à ta variable... [On ne solutionne pas sans voir le détail]
Oui. Tu as raison, je vais te montrer la macro de base.
Ce que je voudrais c'est la faire tourner sur un fichier déjà importé ... D'habitude quand je la fait tourner, une fenetre s'ouvre, je choisi le fichier et ensuite tout se fait.
J'aimerais que ca se fasse en deux étapes, tu vois ce que je veux dire ? D'abord importer les données, puis la faire tourné ou non. (car parfois il faut réaranger certaines colonnes.
Merci de ton aide
' Global Variables
Public Const dstSheet = "Sheet1"
Public Const iWeeksToGet = 4
Public srcSheet As String
Sub Main()
Call Import_CSV
Call CopyHeader
Call copyData
Call VLookups
Call FormatColumns
Call Sort
End Sub
Sub Sort()
Range("A2").Select
Range(Selection, Selection.SpecialCells(xlLastCell)).Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("N1"), Order1:=xlAscending, Orientation:=xlTopToBottom
Range("A1").Select
End Sub
Sub Import_CSV()
Dim FName As Variant
Dim Filter As String
Filter = "Excel Files (*.csv),*.csv"
wbName = ActiveWorkbook.Name
' Ask for the csv file to import
FName = Application.GetOpenFilename(filefilter:=Filter)
' Derive the xls sheetname from the file
aFilename = Split(FName, "\")
strFilename = aFilename(UBound(aFilename))
srcSheet = Left(strFilename, Len(strFilename) - 4)
' Open the csv file
Workbooks.Open Filename:=FName
' Move the xls sheet to the current xls
Windows(strFilename).Activate
Sheets(srcSheet).Select
Sheets(srcSheet).Copy Before:=Workbooks(wbName).Sheets(1)
Application.WindowState = xlMinimized
' Close the other xls
Windows(strFilename).Activate
ActiveWindow.Close
End Sub
Sub CopyHeader()
' copy the heading
j = 1
Do Until j = 14
strData = Worksheets(srcSheet).Cells(1, j).Value
Worksheets(dstSheet).Cells(1, j).Value = strData
j = j + 1
Loop
Worksheets(dstSheet).Cells(1, 14).Value = "Day"
Worksheets(dstSheet).Cells(1, 15).Value = "Hours"
Worksheets(dstSheet).Cells(1, 16).Value = "Comment"
Rows("1:1").Select
Selection.Font.Bold = True
End Sub
Sub copyData()
Dim aDay(1, 6)
iCurrentYear = DatePart("yyyy", Now())
iCurrentWeek = DatePart("ww", Now())
iSrc = 2
iDst = 2
iColumnAccDesc = GetColumnHeader("Account Description", srcSheet)
iColumnMonday = GetColumnHeader("Monday Amount of Expended Hours", srcSheet)
Do
dDate = Worksheets(srcSheet).Cells(iSrc, 1).Value
iYear = DatePart("yyyy", dDate)
iWeeks = DatePart("ww", dDate)
If iYear = iCurrentYear And iWeeks >= (iCurrentWeek - iWeeksToGet) Then
If InStr(1, LCase(Worksheets(srcSheet).Cells(iSrc, iColumnAccDesc).Value), "rfs") <> 0 Then
' Create the array of days & comments
iDay = iColumnMonday
For r = 0 To 1
For c = 0 To 6
aDay(r, c) = Worksheets(srcSheet).Cells(iSrc, iDay).Value
iDay = iDay + 1
Next
iDay = iColumnMonday + 7
Next
' Fill in the data in the destination sheet
For i = 0 To 6
If aDay(0, i) <> 0 Then
For j = 1 To iColumnMonday - 1
Worksheets(dstSheet).Cells(iDst, j).Value = Worksheets(srcSheet).Cells(iSrc, j).Value
Next
Worksheets(dstSheet).Cells(iDst, iColumnMonday).Value = GetDay(i)
Worksheets(dstSheet).Cells(iDst, iColumnMonday + 1).Value = aDay(0, i)
Worksheets(dstSheet).Cells(iDst, iColumnMonday + 2).Value = aDay(1, i)
iDst = iDst + 1
End If
Next
End If
End If
iSrc = iSrc + 1
Loop Until Worksheets(srcSheet).Cells(iSrc, 1).Value = ""
End Sub
Sub FormatColumns()
Sheets("Sheet1").Select
Columns("A:Z").Select
'Selection.ColumnWidth = 70
With Selection
.WrapText = False
End With
End Sub
Sub VLookups()
' VLookup Name
Sheets(dstSheet).Select
iColumnEmployee = GetColumnHeader("Employee Name", dstSheet)
Columns(iColumnEmployee).Insert Shift:=xlRight
Worksheets("Sheet1").Cells(1, iColumnEmployee).Value = "Employee Name"
Worksheets("Sheet1").Cells(1, iColumnEmployee + 1).Value = "Employee"
j = 2
Do
strName = Worksheets("Sheet1").Cells(j, iColumnEmployee + 1).Value
strName = Replace(strName, ",", "")
strFullname = Vlookup_name(strName)
Worksheets("Sheet1").Cells(j, iColumnEmployee).Value = strFullname
j = j + 1
Loop Until Worksheets("Sheet1").Cells(j, 1).Value = ""
' VLookup Project
iColumnProjectDesc = GetColumnHeader("Activity Labour Description", dstSheet)
' Let's first add a column with the project code, extracted from the desription
Sheets(dstSheet).Select
Columns(iColumnProjectDesc).Insert Shift:=xlRight
Worksheets("Sheet1").Cells(1, iColumnProjectDesc).Value = "Project Code"
j = 2
Do
strProjectCode = Worksheets("Sheet1").Cells(j, iColumnProjectDesc + 1).Value
iChar = InStr(strProjectCode, "%")
If iChar <> 0 Then strProjectCode = Left(strProjectCode, iChar - 1)
Worksheets("Sheet1").Cells(j, iColumnProjectDesc).Value = strProjectCode
j = j + 1
Loop Until Worksheets("Sheet1").Cells(j, 1).Value = ""
' Insert the Project Type
Sheets(dstSheet).Select
iColumnProjectCode = GetColumnHeader("Project Code", dstSheet)
Columns(iColumnProjectCode).Insert Shift:=xlRight
Worksheets("Sheet1").Cells(1, iColumnProjectCode).Value = "Project Type"
j = 2
Do
strProjectCode = Worksheets("Sheet1").Cells(j, iColumnProjectCode + 1).Value
strProjectType = Vlookup_Project(strProjectCode)
Worksheets("Sheet1").Cells(j, iColumnProjectCode).Value = strProjectType
j = j + 1
Loop Until Worksheets("Sheet1").Cells(j, 1).Value = ""
End Sub
Function Vlookup_name(strName)
Check = ""
For i = 2 To 200
strShortname = Worksheets("vlookup_name").Cells(i, 1).Value
If LCase(strShortname) = LCase(strName) Then
Vlookup_name = Worksheets("vlookup_name").Cells(i, 2).Value
Exit For
End If
Next
End Function
Function Vlookup_Project(strProject)
Check = ""
For i = 2 To 700
strProjectname = Worksheets("vlookup_projet").Cells(i, 1).Value
If LCase(strProjectname) = LCase(strProject) Then
Vlookup_Project = Worksheets("vlookup_projet").Cells(i, 2).Value
Exit For
End If
Next
End Function
Function GetColumnHeader(strHeader, strSheet)
k = 0
Do
k = k + 1
strData = Worksheets(strSheet).Cells(1, k).Value
If k > 20 Then Exit Function
Loop Until LCase(strData) = LCase(strHeader)
GetColumnHeader = k
End Function
Function GetDay(iNumber)
Select Case iNumber
Case 0
GetDay = "Mon"
Case 1
GetDay = "Tue"
Case 2
GetDay = "Wed"
Case 3
GetDay = "Thu"
Case 4
GetDay = "Fri"
Case 5
GetDay = "Sat"
Case 6
GetDay = "Sun"
End Select
End FunctionsrcSheet est bien une variable de type String, à laquelle est affectée le nom de la feuille importée.
Donc pas de problème lorsque les macros s'enchaînent. Si tu veux la faire fonctionner indépendamment, pas de problème en principe si le nom de la feuille n'a pas changé puisqu'il s'agit d'une variable module (et bien sûr si entretemps on n'a pas fermé puis rouvert le classeur, ce qui réinitialise les variables).
Il faut donc savoir si le nom a changé et éventuellement si la position dans le classeur a changé aussi, pour définir l'affectation qui convient si nécessaire.
Cordialement