Vanuit Revit (Bouwkundig 3D modeleer programma) maken wij door middel van Python een aantal CSV bestanden (1x projectinfo, 7x modeldata/-dimensies). Nu wil ik deze importeren in een Excel bestand met VBA. Het importeren lukt, maar er gebeurd nog wel iets vreemds wat ik na een dag puzzelen nog niet voor elkaar kan krijgen.
In onderstaande code doe ik het volgende:
Nu zit ik al anderhalve dag te klieren om e.e.a. aan te passen en gewoon in de daarvoor bestemde cellen te krijgen, maar ik krijg het niet voor elkaar... Iemand hier een oplossing voor? Het is hetzelfde script, de cellen die gevuld dienen te worden zijn leeg...
Zie ook bijgevoegde afbeeldingen (leeg, correct en fout)
In onderstaande code doe ik het volgende:
- Een aantal variabelen definieren
- De namen van de CSV bestanden in een array zetten
- Controleren of alle CSV bestanden bestaan
- Stoppen als ik onvoldoende CSV bestanden heb (ze worden in Python altijd allemaal aangemaakt)
- Mijn Excel werkbladen in een array stoppen
- Excel vullen met projectinfo uit de CSV (data_fill = 8)
- Excel vullen met de modeldata uit de CSV's
Nu zit ik al anderhalve dag te klieren om e.e.a. aan te passen en gewoon in de daarvoor bestemde cellen te krijgen, maar ik krijg het niet voor elkaar... Iemand hier een oplossing voor? Het is hetzelfde script, de cellen die gevuld dienen te worden zijn leeg...
Zie ook bijgevoegde afbeeldingen (leeg, correct en fout)
Code:
Sub CSV_inladen()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Dim File As String
Dim teller As Integer
teller = 0
Dim Missers As String
Missers = ""
' csv in array
Dim CSV(1 To 8) As String
' csv bestanden vastleggen
CSV(1) = "wanden_data"
CSV(2) = "vloeren_data"
CSV(3) = "plafonds_data"
CSV(4) = "liggers_data"
CSV(5) = "kolommen_data"
CSV(6) = "daken_data"
CSV(7) = "overige_data"
CSV(8) = "projectinfo_data"
' Loopje voor het tellen en controleren
For c = 1 To UBound(CSV)
File = ThisWorkbook.Path & "\csv_bestanden\" & CSV(c) & "*.csv"
Filename = Dir(File)
If Filename <> "" Then
teller = teller + 1
Else
Missers = Missers & Chr(13) & " - " & CSV(c) & ".csv"
End If
Next c
' controle of CSV bestanden bestaan
If teller = 0 Then
MsgBox "Geen CSV-bestanden gevonden. Zorg dat deze op de juiste manier aangemaakt worden.", vbCritical + vbOKOnly, "Geen data"
ElseIf teller < UBound(CSV) Then
MsgBox "Onvoldoende CSV-bestanden gevonden. Zorg dat deze op de juiste manier aangemaakt worden. De volgende CSV bestanden ontbreken:" & Missers, vbCritical + vbOKOnly, "Geen data"
Else
' werkbladen in array
Dim Sh(1 To 8) As String
' werkbladen vastleggen
Sh(1) = "wanden_meetstaat"
Sh(2) = "vloeren_meetstaat"
Sh(3) = "plafonds_meetstaat"
Sh(4) = "liggers_meetstaat"
Sh(5) = "kolommen_meetstaat"
Sh(6) = "daken_meetstaat"
Sh(7) = "overige_categorien"
Sh(8) = "meetstaat_instructie"
For data_fill = 1 To UBound(Sh)
' werkblad en csv-bestand bepalen
Set WS = ActiveWorkbook.Sheets(Sh(data_fill))
csvFile = ThisWorkbook.Path & "\csv_bestanden\" & CSV(data_fill) & ".csv"
' excel vullen uit csv
If data_fill = 8 Then
With WS.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=WS.Range("F2"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Else
With WS.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=WS.Range("A5"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
'.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
' querytables verwijderen
On Error GoTo nothingtodelete
Sheets(Sh(data_fill)).QueryTables(1).SaveData = False
Sheets(Sh(data_fill)).QueryTables.Item(1).Delete
nothingtodelete:
Next data_fill
' melding met verwerkte tijd
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "Data toegevoegd in " & SecondsElapsed & " seconden", vbOKOnly + vbInformation, "Data toegevoegd"
End If
End Sub