o0o
Thành viên mới

- Tham gia
- 6/12/07
- Bài viết
- 21
- Được thích
- 5
Em có đoạn code VBA như bên dưới được lưu trong file Excel (chạy bằng Excel thì okie).
Tuy nhiên, khi open file Excel bằng OpenOffice hoặc LibreOffice thì nó bị báo lỗi ở 3 chỗ:
- Set foundCell = .Cells.Find( ....
=> Cái này xóa chữ Set đi thì okie. Không hiểu vì sao vậy.
- FindNext(foundCell)
=> Không hiểu lệnh FindNext cần viết như thế nào cho nó hiểu.
- AddShape()
=> Lệnh AddShape cũng không hiểu cần sửa lại thế nào.
Em cần sửa lại như thế nào ?
Mấy bác chưa pro về OpenOffice cũng có thể giúp em bằng cách gợi ý về cách viết khác của các lệnh trên giúp em với nhé.
Tuy nhiên, khi open file Excel bằng OpenOffice hoặc LibreOffice thì nó bị báo lỗi ở 3 chỗ:
- Set foundCell = .Cells.Find( ....
=> Cái này xóa chữ Set đi thì okie. Không hiểu vì sao vậy.
- FindNext(foundCell)
=> Không hiểu lệnh FindNext cần viết như thế nào cho nó hiểu.
- AddShape()
=> Lệnh AddShape cũng không hiểu cần sửa lại thế nào.
Em cần sửa lại như thế nào ?
Mấy bác chưa pro về OpenOffice cũng có thể giúp em bằng cách gợi ý về cách viết khác của các lệnh trên giúp em với nhé.
Mã:
Option Explicit
Private Sub drawMemo()
Dim shapename As String
Dim arrMemo() As String, cntMemo As Long
Dim foundCell As Range, FirstAddress As String, foundRow As Long
shapename = "Product"
cntMemo = -1
ReDim arrMemo(0)
With Worksheets(1)
Set foundCell = .Cells.Find(What:=shapename _
, LookIn:=xlValues, LookAt:=xlWhole _
, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False, SearchFormat:=False)
If Not foundCell Is Nothing Then
FirstAddress = foundCell.Address
Do
foundRow = foundCell.Cells.Row
cntMemo = cntMemo + 1
ReDim Preserve arrMemo(cntMemo)
arrMemo(cntMemo) = .Cells(foundRow, 1) & " " & .Cells(foundRow, 2) & " " & .Cells(foundRow, 3)
Set foundCell = .Cells.FindNext(foundCell)
If foundCell Is Nothing Then Exit Do
Loop Until foundCell.Address = FirstAddress
End If
End With
If cntMemo <> -1 Then
Call addMemo(shapename, arrMemo)
End If
EndProc:
End Sub
Private Sub addMemo(shapename As String, arrMemo() As String)
Dim shapeMemoObj As Shape
Dim start As Long, memo As String
Set shapeMemoObj = Worksheets(2).Shapes.AddShape(16, 50, 50, 120, 45)
With shapeMemoObj
.Name = "MEMO" & shapename
.Line.DashStyle = msoLineRoundDot
With .TextFrame
memo = Join(arrMemo, vbLf)
For start = 1 To Len(memo) Step 255
If (start + 254) <= 32767 Then
.Characters(start, 255).Text = _
Mid$(memo, start, 255)
Else
.Characters(start, 32767 - start + 1).Text = _
Mid$(memo, start, 32767 - start + 1)
Exit For
End If
Next start
End With
End With
End Sub