Hallo,
Voor autocad heb ik een plugin gemaakt in VBA. Het heeft goed gewerkt. Na allerlei wijzigen werkt het nu niet meer. Dit probleem heb ik eerder gehad en tot nu toe constant kunnen oplossen. Ditmaal al meerdere dagen een het spelen met objecten, maar ik krijg het niet werkend.
Eerste keer gaat goed, tweede keer gaat het fout. Ik heb al veel dingen geprobeerd. Objecten leeg maken(oBook = nothing), weggooien, etc. Tot nu toe heeft nog niks het probleem op gelost. Ziet iemand hieronder een fout omtrent de melding remote server is unavailable?(De code zaten meer objecten, onder andere om voor sheets en ranges, ik heb omgezet voor gebruik van 1 object met de hoop dat het probleem makkelijker te vinden is)
CODE KLOPT NIET. AANTAL DINGEN VERWIJDERD OM HET WAT TE VERKLEINEN. AANTAL DIM VERWIJDERD EN AANTAL REGELS WAAR DE WAARDES WORDEN GEVULD
Public object aangemaakt in de module, main wordt gestart, vervolgens word het object excel gebruikt in createlist.
Voor autocad heb ik een plugin gemaakt in VBA. Het heeft goed gewerkt. Na allerlei wijzigen werkt het nu niet meer. Dit probleem heb ik eerder gehad en tot nu toe constant kunnen oplossen. Ditmaal al meerdere dagen een het spelen met objecten, maar ik krijg het niet werkend.
Eerste keer gaat goed, tweede keer gaat het fout. Ik heb al veel dingen geprobeerd. Objecten leeg maken(oBook = nothing), weggooien, etc. Tot nu toe heeft nog niks het probleem op gelost. Ziet iemand hieronder een fout omtrent de melding remote server is unavailable?(De code zaten meer objecten, onder andere om voor sheets en ranges, ik heb omgezet voor gebruik van 1 object met de hoop dat het probleem makkelijker te vinden is)
CODE KLOPT NIET. AANTAL DINGEN VERWIJDERD OM HET WAT TE VERKLEINEN. AANTAL DIM VERWIJDERD EN AANTAL REGELS WAAR DE WAARDES WORDEN GEVULD
Public object aangemaakt in de module, main wordt gestart, vervolgens word het object excel gebruikt in createlist.
Code:
Option Explicit
Dim Count, Index, tempString, attrib, TagName
Dim arraytekening()
Dim BlockAttributes
Public oBook As excel.Application
Sub main()
Dim aantallengteeenheid() As String
ReDim aantallengteeenheid(0)
ReDim lengteeenheid(0)
Dim a As Integer
Dim myArray() As Long
Dim sKillExcel
sKillExcel = "TASKKILL /F /IM Excel.exe"
Set oBook = New excel.Application
oBook.Workbooks.Open ("c:\triexport\tmp.xlsm")
projectnr = ""
subnr = ""
Count = ThisDrawing.ActiveLayout.Block.Count
a = 0
For Index = 0 To Count - 1
tempString = ThisDrawing.ActiveLayout.Block(Index).ObjectName
If tempString = "AcDbBlockReference" Then
blockname = ThisDrawing.ActiveLayout.Block(Index).Name
If blockname = "roh2" Or blockname = "roh4" Or blockname = "MAGGDAMM2" Or blockname = "MAGGDAMM1" Or blockname = "ROHDAMM-5-2" Then
a = a + 1
End If
End If
Next Index
a = a + 1
ReDim arraytekening(0 To a, 0 To 18)
a = 0
For Index = 0 To Count - 1
tempString = ThisDrawing.ActiveLayout.Block(Index).ObjectName
If tempString = "AcDbBlockReference" Then
blockname = ThisDrawing.ActiveLayout.Block(Index).Name
If blockname = "roh4" Or blockname = "MAGGDAMM2" Or blockname = "MAGGDAMM1" Then
BlockAttributes = ThisDrawing.ActiveLayout.Block(Index).GetAttributes
For Each attrib In BlockAttributes
If omschrijving = "" Then omschrijving = fomschrijving(attrib.TagString, attrib.TextString)
If typekleur = "" Then typekleur = ftypekleur(attrib.TagString, attrib.TextString)
If artikelnummer = "" Then artikelnummer = fartikelnummer(attrib.TagString, attrib.TextString)
If UBound(aantallengteeenheid, 1) = 0 Then aantallengteeenheid = faantallengteeenheid(attrib.TagString, attrib.TextString)
If omschrijving <> "" And typekleur <> "" And artikelnummer <> "" And UBound(aantallengteeenheid, 1) <> 0 Then
arraytekening(a, 5) = omschrijving
a = a + 1
omschrijving = ""
typekleur = ""
artikelnummer = ""
ReDim aantallengteeenheid(0)
End If
Next attrib
End If
If blockname = "roh2" Or blockname = "ROHDAMM-5-2" Then
BlockAttributes = ThisDrawing.ActiveLayout.Block(Index).GetAttributes
For Each attrib In BlockAttributes
If omschrijving = "" Then omschrijving = fomschrijving(attrib.TagString, attrib.TextString)
If UBound(aantallengteeenheid, 1) = "0" Then aantallengteeenheid = faantallengteeenheid(attrib.TagString, attrib.TextString)
If typekleur = "" Then typekleur = ftypekleur(attrib.TagString, attrib.TextString)
If artikelnummer = "" Then artikelnummer = fartikelnummer(attrib.TagString, attrib.TextString)
If UBound(lengteeenheid, 1) = 0 Then lengteeenheid = flengteeenheid(attrib.TagString, attrib.TextString, aantallengteeenheid(0))
If omschrijving <> "" And typekleur <> "" And artikelnummer <> "" And UBound(aantallengteeenheid, 1) <> 0 And UBound(lengteeenheid, 1) <> 0 Then
arraytekening(a, 5) = omschrijving
a = a + 1
omschrijving = ""
ReDim aantallengteeenheid(0)
typekleur = ""
artikelnummer = ""
ReDim lengteeenheid(0)
End If
Next attrib
End If
If blockname = "roh" Or blockname = "roh aangepast" Or blockname = "ROHDAMM-5" Then
BlockAttributes = ThisDrawing.ActiveLayout.Block(Index).GetAttributes
For Each attrib In BlockAttributes
If projectnr = "" Then projectnr = fprojectnummer(attrib.TagString, attrib.TextString)
If subnr = "" Then subnr = fsubnummer(attrib.TagString, attrib.TextString)
Next attrib
End If
End If
Next Index
If Left(projectnr, 1) = "P" And Len(projectnr) = "7" Then
If Len(subnr) = "2" Then
lastrow = (UBound(arraytekening, 1) - 1)
arraytekening(lastrow, 6) = "1"
readExcel
If errortxt <> "" Then
GoTo errorHandler
End If
Else
errortxt = "Subnummer is niet juist ingevuld"
GoTo errorHandler
End If
Else
errortxt = "Projectnummer is niet juist ingevuld"
GoTo errorHandler
End If
For I = 0 To (UBound(arraytekening, 1) - 1)
If arraytekening(I, 9) = "" Or arraytekening(I, 9) = "-" Or Left(arraytekening(I, 9), 3) = "D07" Then
toegevoegd = toegevoegd & vbCrLf & "Omschr:" & arraytekening(I, 5) & ", Type/kleur:" & arraytekening(I, 18) & " <-------Niet toegevoegd"
End If
Next
MsgBox toegevoegd & vbCrLf & vbCrLf & "EXPORT WORD NU UITGEVOERD. TRIMERGO HEEFT EEN AANTAL SECONDEN NODIG OM DIT TE VERWERKEN."
oBook.Workbooks("tmp.xlsm").Saved = True
oBook.Workbooks("tmp.xlsm").Close False
Shell sKillExcel, vbHide
Exit Sub
errorHandler:
MsgBox ("ERROR: " & errortxt & vbCrLf & vbCrLf & "--Export is niet uitgevoerd--")
errortxt = ""
End Sub
Sub readExcel()
Dim projectnummer As String
Dim nRow As Integer
Dim nCol As Integer
Dim rijnummer As String
Dim eenheid As String
Dim x As String
Dim rng As range
Dim sKillExcel
sKillExcel = "TASKKILL /F /IM Excel.exe"
Err.Clear
If (Err.Number <> 0) Then
MsgBox Err.Number
Exit Sub
End If
For I = 0 To (UBound(arraytekening, 1) - 1)
'Sheets("Settings").Activate
arraytekening(I, 0) = "tttt"
arraytekening(I, 1) = "N"
arraytekening(I, 2) = arraytekening(I, 1)
'Sheets("TriArticles").Activate
arraytekening(I, 3) = projectnr
arraytekening(I, 4) = subnr
arraytekening(I, 12) = "N" 'purchase
If arraytekening(I, 9) <> "" And arraytekening(I, 9) <> "-" And arraytekening(I, 9) <> "Vrij" Then
' On Error GoTo errorLn
rijnummer = WorksheetFunction.Match(arraytekening(I, 9), oBook.Worksheets("TriArticles").range("A:A"), 0)
'On Error GoTo errorLn2
arraytekening(I, 5) = WorksheetFunction.VLookup(arraytekening(I, 9), oBook.Worksheets("TriArticles").range("A1:M4000"), 2, False)
arraytekening(I, 13) = WorksheetFunction.VLookup(arraytekening(I, 9), oBook.Worksheets("TriArticles").range("A1:M4000"), 5, False)
arraytekening(I, 14) = WorksheetFunction.VLookup(arraytekening(I, 9), oBook.Worksheets("TriArticles").range("A1:M4000"), 11, False)
arraytekening(I, 15) = WorksheetFunction.VLookup(arraytekening(I, 9), oBook.Worksheets("TriArticles").range("A1:M4000"), 13, False)
arraytekening(I, 8) = "Materiaal"
arraytekening(I, 11) = "N" 'generate
arraytekening(I, 12) = "Y" 'purchase
x = ""
If arraytekening(I, 7) = "M1" Then
On Error Resume Next
x = WorksheetFunction.Match(arraytekening(I, 7), oBook.Sheets("TriArticles").range("N" & rijnummer & ":W" & rijnummer), 0)
If x = "" Then
On Error GoTo errorLn2:
x = WorksheetFunction.Match("Per Mtr.", oBook.Sheets("TriArticles").range("N" & rijnummer & ":W" & rijnummer), 0)
arraytekening(I, 7) = "Per Mtr."
arraytekening(I, 6) = (arraytekening(I, 16) / 1000) * arraytekening(I, 6)
arraytekening(I, 16) = 0
End If
ElseIf arraytekening(I, 7) = "Per Stuk" Then
On Error Resume Next
x = WorksheetFunction.Match(arraytekening(I, 7), oBook.Sheets("TriArticles").range("N" & rijnummer & ":W" & rijnummer), 0)
If x = "" Then
On Error GoTo errorLn2:
x = WorksheetFunction.Match("Per set", oBook.Sheets("TriArticles").range("N" & rijnummer & ":W" & rijnummer), 0)
arraytekening(I, 7) = "Per set"
End If
Else
On Error GoTo errorLn2:
eenheid = WorksheetFunction.Match(arraytekening(I, 7), oBook.Sheets("TriArticles").range("N" & rijnummer & ":W" & rijnummer), 0)
End If
ElseIf arraytekening(I, 9) = "Vrij" Then
arraytekening(I, 8) = "Vrij"
arraytekening(I, 11) = "Y" 'generate
arraytekening(I, 12) = "N" 'purchase
End If
check:
Next
createQuotationMaterialsAndHoursXml
Exit Sub
errorLn:
errortxt = (arraytekening(I, 9) & " STAAT NIET IN DE PRIJSLIJST, INDIEN ARTIKEL WEL IN PRIJSLIJST STAAT, SCHREEUW NAAR DE SYSTEEMBEHEERDER VOOR HULP")
Exit Sub
errorLn2:
UserForm2.changeunitform oBook.Sheets("TriArticles").range("N" & rijnummer & ":W" & rijnummer), arraytekening(I, 9), arraytekening(I, 5), arraytekening(I, 6), arraytekening(I, 16), arraytekening(I, 17), arraytekening(I, 7)
arraytekening(I, 7) = UserForm2.newunit
arraytekening(I, 6) = UserForm2.newcount
arraytekening(I, 16) = UserForm2.newlength
arraytekening(I, 17) = UserForm2.newwidth
Unload UserForm2
Resume check:
Exit Sub
End Sub
Laatst bewerkt:
