Topic: Copy a text from cells from Excel, paste it in Autocad

[arindaprachman]

hello

I want to copy a value/text in cells from excel and paste it in specific mtxt that has been made in existing .DWG file.
I have done it by copy and paste, but it doesn't work effectively since there's too many cells to be pasted.

Is there anyone who know about vba (macro) script that will help me to solve my problem?

PS:
one off my cells entry which should be copy is in D5 and the coordinate of mtxt in autocad is (17,46 15,03 0,000)
both of those file is located in same folder


Thank you 

[fixo]

Try this code, not mine though
See comments in this routine

Code: [Select]

Option Explicit
''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''

Public mtextStr As String

''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''
Public Sub testCopyCell()
ExcelTemplateFunction ThisDrawing.GetVariable("dwgprefix") & "MyFile.xlsx" '<~~ change excel file path
Dim pt(2) As Double
pt(0) = 100#: pt(1) = 100#: pt(2) = 0#: '<~~ change point coordinates
Dim oMtext As AcadMText
Set oMtext = ThisDrawing.ModelSpace.AddMText(pt, 0#, mtextStr)
ThisDrawing.SendCommand ("_copybase (list 100.0 100.0 0.0) _L ") & vbCr
ThisDrawing.SendCommand ("(command)")
oMtext.Delete
End Sub

''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''

' borrowed from Desmond Oshiwambo
' http://desmondoshiwambo.wordpress.com/2013/06/17/template-function-to-connect-to-excel-from-access-using-vba-automation/

''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''

Public Function ExcelTemplateFunction(xlFileName As String)

On Error GoTo ErrorHandler
Dim xlApp As Object
Dim xlWB As Object
Dim xlWS As Object
Dim xlRange As Object
Set xlApp = CreateObject("Excel.Application")
'Set xlWB = xlApp.Workbooks.Add
Set xlWB = xlApp.Workbooks.Open(xlFileName, False)
Set xlWS = xlWB.Worksheets(1)
With xlWS
Set xlRange = .Range("D5") '<~~ change cell address
mtextStr = CStr(xlRange.Value)
End With
'Show Excel
xlApp.Visible = True
ExcelTemplateFunction = True
GoTo CleanExit
ErrorHandler:
Debug.Print Err.Description
ExcelTemplateFunction = False
CleanExit:
'Close Excel - do not save
If Not (xlWB Is Nothing) Then
xlWB.Close False
'Close workbook (don't save)
If Not (xlApp Is Nothing) Then
xlApp.Quit      'Quit
End If
End If
'Destroy objects

Set xlRange = Nothing
Set xlWS = Nothing
Set xlWB = Nothing
Set xlApp = Nothing

End Function
''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''