How to paste value of cell A1 to cell B1 from corel draw12"

[nfgiosanu]

Hi!
I'm a newbie in vba.
I need copy the value of cell A1 an paste it in cel B2.
I need to do that from corel draw 12 to Excel 2003.

10x

[Aaron Blood]

This probably belongs in the Office Integration forum...
Done by firefytr..

Personally, I've never messed with pulling things outta Corel.

[nfgiosanu]

Sub ATest() 
Dim b As Object
Set b = GetObject("D:\Alta-Lingua\HAAS 5\corel script\trados.xls")
For n = 1 To 50 ' no of doc
Documents(n).Activate
Dim s As Shape
For Each s In ActivePage.FindShapes(, cdrTextShape)
s.Text.BeginEdit
'line 1
Set t = s.Text
t.Story.Paragraphs.Item(1).Copy
b.worksheets("temp").Paste Destination:=b.worksheets("temp").Range("A3") 'paste in cel A3
b.worksheets("temp").Range("A3:A9") = b.worksheets("temp").Range("C3:C9").Value 'clean cells
b.worksheets("temp").Range("B2:B8") = b.worksheets("temp").Range("C3:C9").Value 'clean cells
b.worksheets("temp").Range("B1:B8") = b.worksheets("temp").Range("A3:A9").Value 'B1=A2
b.worksheets("temp").Range("A1") = b.worksheets("temp").Range("A2").Value 'A1=A2
For x = 1 To 600
If b.worksheets("baza").cells(x, 3) = b.worksheets("temp").cells(1, 1) Then
b.worksheets("temp").cells(1, 2) = b.worksheets("baza").cells(x, 4)
Exit For
End If
Next x
b.worksheets("temp").cells(1, 2).Copy
SendKeys "^{v}", True
'end line 1
SendKeys "^{ }", True
Next s
'Next n
End Sub

My problem is that the values from the baza sheet no longer get in to the B1 cell.

[mdmackillop]

Hi, and welcome to VBAX
If you select your code and click on the VBA button, it formats it as above, making it more readable. If you want to post an attachment, use the Go Advanced button below the message box and click on Manage Attachments. You can send zipped data files and a few other types.
Regards
MD

[nfgiosanu]

10x

I Solved my problem.

If you (mdmackillop) think is helpful, I'll postit here

[Zack Barresse]

If you (mdmackillop) think is helpful, I'll postit here

Please do! (If I count.. )

[nfgiosanu]

Sub HAAS5EPS()
Dim q
Dim b As Object
Set b = GetObject("D:\Alta-Lingua\HAAS 5\corel script\trados.xls")
Set tt = b.worksheets("temp")
Set tb = b.worksheets("baza")
Dim cdr
cdr = Documents.Count
For n = 2 To cdr ' no of doc
Documents(n).Activate
Dim s As Shape
For Each s In ActivePage.FindShapes(, cdrTextShape) 
s.Text.BeginEdit
Set t = s.Text
q = t.Story.Paragraphs.Count
For w = 1 To q
t.Story.Paragraphs.Item(w).Copy
tt.Range("A3:A7").clearcontents
tt.Paste Destination:=tt.Range("A3") 'paste in cel A3
tt.cells(1, 2) = tt.cells(2, 1) 'B1=A2
tt.Range("A1") = tt.Range("A2").Value 'A1=A2
For x = 1 To 600
If tb.cells(x, 3) = tt.cells(1, 1) Then
tt.cells(1, 2) = tb.cells(x, 4)
Exit For
End If
Next x
tt.cells(1, 2).Copy
SendKeys "^{v}", True
SendKeys "{ENTER}", True
Next w
SendKeys "{BACKSPACE}", True
SendKeys "^{ }", True
Next s
Next n
End Sub

Please post your comments.
I'm want to learn and optimize the script

10x

[nfgiosanu]

Please do! (If I count.. )

U count too

[Anne Troy]

nfgiosanu: Thanks!! Some of us DO have CorelDraw and have never used it with VBA! The more, the merrier!!



You can mark your question solved (if it is) by hitting Thread Tools (at the top) and choosing Mark Solved.

[nfgiosanu]

now i try to give a graphical interface to my script