hello everyone. I'm coding a macro and I've reached an important point, but I'm getting an error. I want to ask you for help.
In the image below, the user enters the starting level manually and this process continues from the top of the product tree to the lower parts.
However, when the number of nested products increases, the output goes to wrong results. I am sharing my codes. Can you suggest me a solution? Alternatively, can anyone who has done such a study help? I'm new to this forum and have no experience yetvisual studio,visual studioAutomationvisual basic
First, I want to talk about the working system.
-User enters an initial value and selects standard / option (picture 1)
-Examines all parts in the active document, starting from the top product to the end.
-Then, it writes the part number and part definition sections one by one into the Excel cell in the Excel format I designed. (Picture 2)
-Then, for the counting process, I delete the repeating parts and as soon as I delete it, I give a value of +1 to a variable and write it in the pcs column.
-For levels, if the first product.count encountered is >0, I increase the level by 1 and add it to the level cells.
-Then, if the product quantity is greater than 1, I divide it by the upper value when it goes to level 9 until the next product section. You can see it in Picture 3.
Picture 1
Picture 2
Picture 3
My Code:
Private Sub CommandButton1_Click()
Dim CATIA As Object
Dim ProductDocument As Object
Dim Product As Object
Dim oChildren As Variant
Dim i As Integer
Dim ExcelApp As Object
Dim ExcelWorkbook As Object
Dim ExcelSheet As Object
Dim uaseviyedegeri As Integer
Dim startRow As Integer
startRow = 4 'ESKİ DEĞERİ 3
uaseviyedegeri = TextBox1.Text
' Catia'yı başlat
Set CATIA = GetObject(, "CATIA.Application")
If CATIA Is Nothing Then
MsgBox "CATIA bulunamadı. Lütfen Catia'yı başlatın.", vbExclamation
Exit Sub
End If
' Aktif belgeyi al
Set ProductDocument = CATIA.ActiveDocument
' Ürünü al
Set Product = ProductDocument.Product
' Excel uygulamasını başlat
Set ExcelApp = CreateObject("Excel.Application")
ExcelApp.Visible = True
' Yeni bir Excel çalışma kitabı oluştur
Set ExcelWorkbook = ExcelApp.Workbooks.Add
Set ExcelSheet = ExcelWorkbook.Sheets(1)
ExcelSheet.Name = Product.PartNumber
' Excel sayfasına başlık satırını yaz
With ExcelWorkbook.Sheets(1)
' Excel sayfasına başlık satırını yaz
.Range("A1:I1").Merge
.Range("A1:I1").Value = "Level"
.Range("A2").Value = "1"
.Range("B2").Value = "2"
.Range("C2").Value = "3"
.Range("D2").Value = "4"
.Range("E2").Value = "5"
.Range("F2").Value = "6"
.Range("G2").Value = "7"
.Range("H2").Value = "8"
.Range("I2").Value = "9"
.Range("J1:J2").Merge
.Range("J1:J2").Value = "Part Code"
.Range("K1:K2").Merge
.Range("K1:K2").Value = "Product/Part Definition"
.Range("L1:L2").Merge
.Range("L1:L2").Value = "Type"
.Range("M1:M2").Merge
.Range("M1:M2").Value = "Unit"
.Range("N1:N2").Merge
.Range("N1:N2").Value = "Pcs."
.Range("O1:O2").Merge
.Range("O1:O2").Value = "Revision Number"
.Range("P1:P2").Merge
.Range("P1:P2").Value = "Revision Level"
.Range("Q1:Q2").Merge
.Range("Q1:Q2").Value = "Publish Date"
.Range("R1:R2").Merge
.Range("R1:R2").Value = "STD/OPS"
' Hücreleri biçimlendir
With .Range("A1:R2")
.HorizontalAlignment = -4108 ' xlCenter
.VerticalAlignment = -4108 ' xlCenter
.Font.Bold = True
End With
End With
ExcelSheet.cells(3, uaseviyedegeri).Value = uaseviyedegeri
ExcelSheet.Range("J3").Value = Left(Product.PartNumber, 9)
ExcelSheet.Range("K3").Value = Product.Definition
ExcelSheet.Range("N3").Value = "1"
ExcelSheet.Range("R3").Value = ComboBox1.Text
ExportProductTree Product.Products, ExcelSheet, 4, uaseviyedegeri + 1
Dim sonsatir As Integer
With ExcelWorkbook.Sheets(1)
sonsatir = ExcelSheet.cells(ExcelSheet.Rows.Count, "J").End(-4162).Row ' xlUp
For i = 3 To sonsatir
' Kenarlıkları biçimlendir
Const xlEdgeLeft As Long = 7
Const xlEdgeTop As Long = 8
Const xlEdgeBottom As Long = 9
Const xlEdgeRight As Long = 10
Const xlInsideVertical As Long = 11
Const xlInsideHorizontal As Long = 12
Const xlContinuous As Long = 1
.Range("A1:R" & sonsatir).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range("A1:R" & sonsatir).Borders(xlEdgeTop).LineStyle = xlContinuous
.Range("A1:R" & sonsatir).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Range("A1:R" & sonsatir).Borders(xlEdgeRight).LineStyle = xlContinuous
.Range("A1:R" & sonsatir).Borders(xlInsideVertical).LineStyle = xlContinuous
.Range("A1:R" & sonsatir).Borders(xlInsideHorizontal).LineStyle = xlContinuous
Next i
' Sütun genişliklerini otomatik ayarla
.Columns("A:R").AutoFit
End With
Dim j As Integer
For j = 3 To sonsatir
Dim toplam As Integer
Dim k As Integer
toplam = 0
For k = 1 To 9
toplam = toplam + ExcelSheet.cells(j, k).Value
ExcelSheet.cells(j, 19).Value = toplam
Next k
Next j
'Tekrar eden parçaları grupla ve alt alta sırayla yazdır yeni ekledim
GroupAndPrintDuplicates ExcelSheet, startRow
altproductlaribol ExcelSheet, startRow
ExcelSheet.Columns("S:S").Delete
MsgBox "İşlem Tamamlandı", vbOKOnly, "Başarılı"
End Sub
Sub ExportProductTree(oProducts As Variant, ExcelSheet As Object, ByVal startRow As Integer, ByVal uaseviyedegeri As Integer)
Dim i As Integer
Dim oProduct As Object
Dim oChildren As Variant
DoEvents
For i = 1 To oProducts.Count
Set oProduct = oProducts.Item(i)
ExcelSheet.cells(startRow, uaseviyedegeri).Value = uaseviyedegeri
ExcelSheet.cells(startRow, 10).Value = oProduct.PartNumber
ExcelSheet.cells(startRow, 11).Value = oProduct.Definition
ExcelSheet.cells(startRow, 18).Value = ComboBox1.Text
' Parça adlarını yazdır
Set oChildren = oProduct.Products
If oChildren.Count > 0 Then
ExportProductTree oChildren, ExcelSheet, startRow + 1, uaseviyedegeri + 1
startRow = startRow + oChildren.Count
End If
startRow = startRow + 1
Next i
End Sub
Sub GroupAndPrintDuplicates(ExcelSheet As Object, ByVal startRow As Integer)
Dim lastRow As Integer
Dim i As Integer
Dim j As Integer
Dim currentCell As Object
Dim nextCell As Object
Dim currentProduct As String
Dim adet As Integer
adet = 0
DoEvents
lastRow = ExcelSheet.cells(ExcelSheet.Rows.Count, "J").End(-4162).Row ' xlUp
i = startRow
While i <= lastRow
adet = 0
Set currentCell = ExcelSheet.cells(i, 10)
currentProduct = currentCell.Value
j = i + 1
While j <= lastRow
Set nextCell = ExcelSheet.cells(j, 10)
If nextCell.Value = currentProduct Then
adet = adet + 1
currentCell.Value = nextCell.Valuel
nextCell.EntireRow.Delete
lastRow = lastRow - 1 ' Satır silindiğinden dolayı güncelle
Else
j = j + 1
End If
Wend
ExcelSheet.cells(i, 14).Value = adet + 1
i = i + 1
Wend
End Sub
Sub altproductlaribol(ExcelSheet As Object, ByVal startRow As Integer)
Dim lastRow As Integer
Dim i As Integer
Dim j As Integer
Dim currentCell As Object
Dim nextCell As Object
Dim bolecekolansayi As Integer
Dim k As Integer
Dim l As Integer
DoEvents
lastRow = ExcelSheet.cells(ExcelSheet.Rows.Count, "J").End(-4162).Row ' xlUp
i = startRow
While j <= lastRow
Set currentCell = ExcelSheet.cells(i, 19)
j = i + 1
Set nextCell = ExcelSheet.cells(j, 19)
If currentCell.Value < nextCell.Value Then
bolecekolansayi = ExcelSheet.cells(i, 14)
If bolecekolansayi > 1 Then
ExcelSheet.cells(j, 14).Value = ExcelSheet.cells(j, 14).Value / bolecekolansayi
k = i + 1
l = j + 1
While ExcelSheet.cells(k, 19).Value = ExcelSheet.cells(l, 19).Value
ExcelSheet.cells(k + 1, 14).Value = ExcelSheet.cells(l, 14).Value / bolecekolansayi
k = k + 1
l = l + 1
Wend
End If
End If
i = i + 1
Wend
End Sub
Private Sub UserForm_Initialize()
ComboBox1.AddItem "STD"
ComboBox1.AddItem "OPS"
ComboBox1.ListIndex = 0
End Sub