[编程交流] VBA新手帮助。。。

Public excelApp As Object
Public wkbkObj As Object
Public sheetObj As Object
Private Sub CommandButton1_Click()
Dim i, j, BlocksTotal As Integer
Dim Block As AcadBlockReference
Dim BlockName, UniqueBlockName As String
Dim Blk As AcadEntity
'Number of unique blocks
btot = ThisDrawing.Blocks.Count
' Every unique block name goes in Listbox1
For i = 0 To btot - 1
   UniqueBlockName = ThisDrawing.Blocks.Item(i).Name
   If Not Mid$(UniqueBlockName, 1, 1) = "*" And Not UniqueBlockName = "NAME" Then ListBox1.AddItem UniqueBlockName ' Getting rid of *ModelSpace and *PaperSpace and a wrong name of block I have in all drawings
Next i
For j = 0 To ListBox1.ListCount - 1 ' The problem is in this Loop...I cannot find a fast and easy way to count the number of every block name
    UniqueBlockName = ListBox1.List(j) 'picking up block names from listbox1
    BlocksTotal = 0
       For Each Blk In ThisDrawing.ModelSpace ' Here I want to check the name of every block in modelspace (not unique) and if it is the same as the listbox name i have to find its total number and add it to listbox 2
           If Blk.Name = UniqueBlockName Then BlocksTotal = BlocksTotal + 1
       Next
    ListBox2.AddItem BlocksTotal
Next j
End Sub
Private Sub CommandButton2_Click()
Dim i As Integer
On Error Resume Next
   Set excelApp = GetObject(, "Excel.Application")
   If Err <> 0 Then
       Err.Clear
       Set excelApp = CreateObject("Excel.Application")
               If Err <> 0 Then
           MsgBox "ÓöÜëìá êáôÜ ôçí åêêßíçóç ôïõ Excel!", vbExclamation
           End
       End If
   End If
   excelApp.Visible = True
   Set wkbkObj = excelApp.Workbooks.Open(FileName:="c:\dipola.xls")
   Set sheetObj = wkbkObj.Worksheet(2)
For i = 0 To ListBox1.ListCount - 1
   If ListBox1.List(i) = "C13" Then sheetObj.Range("A1").Value = ListBox2.List(i)
   If ListBox1.List(i) = "C1" Then sheetObj.Range("C9").Value = ListBox2.List(i)
Next i
End Sub
Private Sub CommandButton3_Click()
End
End Sub

Dim excelApp As Excel.Application
Dim wbk As Workbook
Dim sht As Worksheet
Private Sub cmdListBlocks_Click()
   
   Dim Block As AcadBlock
   Dim i As Integer
   Dim MyBlockArray() As Variant
   
   i = 0
   
   For Each Block In ThisDrawing.Blocks
   i = i + 1
   
   ReDim Preserve MyBlockArray(2, i)
       MyBlockArray(0, i) = Block.Name
       MyBlockArray(1, i) = Block.Count
   Next Block
   Me.ListBoxBlocks.ColumnCount = 2
   Me.ListBoxBlocks.ColumnWidths = "36;36"
   Me.ListBoxBlocks.Column() = MyBlockArray
End Sub
Private Sub CommandButton1_Click()
Dim i As Integer
ListCount = Me.ListBoxBlocks.ListCount
On Error Resume Next
   Set excelApp = GetObject(, "Excel.Application")
   If Err <> 0 Then
       Err.Clear
       Set excelApp = CreateObject("Excel.Application")
               If Err <> 0 Then
           MsgBox "Εrror Opening Excel!", vbExclamation
           End
       End If
   End If
   excelApp.Visible = True
   Set wkbkObj = excelApp.Workbooks.Open(FileName:="c:\dipola.xls") [b]' here i just open a certain excel Workbook[/b]
   Set sheetObj = wkbkObj.Worksheet(1) [b]' I put the values in the 2nd sheet[/b]
For i = 0 To ListCount - 1
   If ListBoxBlocks.List(i, 0) = "C1" Then Range("B1").Cells.Value = ListBoxBlocks.List(i, 1)
   If ListBoxBlocks.List(i, 0) = "C2" Then Range("B2").Cells.Value = ListBoxBlocks.List(i, 1)  [b]' Here I make a lot of checks so i just wrote two to show the way I send values to certain cells in excel[/b]
Next
wkbkObj.Sheets("DIPOLA").Select [b] ' I focus on the 1st sheet that is the actual report page for the user to print[/b]
End Sub
Private Sub CommandButton2_Click()
End
End Sub