OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > CorelDRAW > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 31-08-2011, 06:36
stergema
Guest
 
Posts: n/a
Default Autorun macro...

Hi. I am new to this forum, and to vba, i have a script that creates guides from selected nodes if a combination of key are pressed, the thing is that i have to click the macro to run, it sees what combination of key are pressed and generate the guides. I want to make it so i don't have to click the macro. If i press for ex: 5+8, i want the macro to generate the guides. Here is the script:
Code:
Declare Function GetKeyState Lib "user32" _
(ByVal nVirtKey As Long) As Integer

Const VK_LEFT As Integer = &H64 'feft arrow from numpad = 6
Const VK_RIGHT As Integer = &H66 'right arrow from numpad = 4
Const VK_UP As Integer = &H68 'up arrow from numpad = 8
Const VK_DOWN As Integer = &H62 'down arrow from numpad = 2
Const VK_FIVE As Integer = &H65  'Shift

Sub ControlCuSageti()
    Dim n As Node, s As Shape, sr As ShapeRange
    Dim x#, y#, sGuide As Guide, sLine As Shape
    Dim x1#, y1#, w1#, h1#
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If ActiveSelection.Shapes.Count = 0 Then
        MsgBox "Selecteaza Gheorghe, care esti tu Gheorghe"
        Exit Sub
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If ActiveShape.Curve.Selection.Count = 0 Then
        MsgBox "Selecteaza nodurile pt generarea ghidelor"
        Exit Sub
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ActiveDocument.BeginCommandGroup "Create lines for guides"
    Set sr = ActiveSelection.Shapes.FindShapes(Query:="@type = 'curve'")
    sr.GetBoundingBox x1, y1, w1, h1
    
    For Each s In sr
        For Each n In s.Curve.Nodes
            If n.Selected Then
If GetKeyState(VK_FIVE) < 0 And GetKeyState(VK_LEFT) < 0 Then
                n.GetPosition x, y
                Set sLine = ActivePage.Layers("ghide").CreateLineSegment(x - 0.5, y, x - 1, y)
ElseIf GetKeyState(VK_FIVE) < 0 And GetKeyState(VK_RIGHT) < 0 Then
                n.GetPosition x, y
                Set sLine = ActivePage.Layers("ghide").CreateLineSegment(x + 0.5, y, x + 1, y)
ElseIf GetKeyState(VK_FIVE) < 0 And GetKeyState(VK_UP) < 0 Then
                n.GetPosition x, y
                Set sLine = ActivePage.Layers("ghide").CreateLineSegment(x, y + 0.5, x, y + 1)
ElseIf GetKeyState(VK_FIVE) < 0 And GetKeyState(VK_DOWN) < 0 Then
                n.GetPosition x, y
                Set sLine = ActivePage.Layers("ghide").CreateLineSegment(x, y - 0.5, x, y - 1)
                End If
                End If
        Next n
    Next s
    End Sub
Thank you.
Reply With Quote
  #2  
Old 31-08-2011, 07:51
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,770
Blog Entries: 10
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Keystroke

Simply divide your macro into each keystroke and then assign the macro to that keystroke. Here is half of it, also I deleted the other post as duplicate.
Code:
Sub ControlCuSagetiLeft()
    Dim n As Node, s As Shape, sr As ShapeRange
    Dim x#, y#, sGuide As Guide, sLine As Shape
    Dim x1#, y1#, w1#, h1#
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If ActiveSelection.Shapes.Count = 0 Then
        MsgBox "Selecteaza Gheorghe, care esti tu Gheorghe"
        Exit Sub
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If ActiveShape.Curve.Selection.Count = 0 Then
        MsgBox "Selecteaza nodurile pt generarea ghidelor"
        Exit Sub
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ActiveDocument.BeginCommandGroup "Create lines for guides"
    Set sr = ActiveSelection.Shapes.FindShapes(Query:="@type = 'curve'")
    sr.GetBoundingBox x1, y1, w1, h1
    
    For Each s In sr
        For Each n In s.Curve.Nodes
            If n.Selected Then
                n.GetPosition x, y
                Set sLine = ActivePage.Layers("ghide").CreateLineSegment(x - 0.5, y, x - 1, y)
            End If
        Next n
    Next s
End Sub

Sub ControlCuSagetiRight()
    Dim n As Node, s As Shape, sr As ShapeRange
    Dim x#, y#, sGuide As Guide, sLine As Shape
    Dim x1#, y1#, w1#, h1#
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If ActiveSelection.Shapes.Count = 0 Then
        MsgBox "Selecteaza Gheorghe, care esti tu Gheorghe"
        Exit Sub
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If ActiveShape.Curve.Selection.Count = 0 Then
        MsgBox "Selecteaza nodurile pt generarea ghidelor"
        Exit Sub
    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ActiveDocument.BeginCommandGroup "Create lines for guides"
    Set sr = ActiveSelection.Shapes.FindShapes(Query:="@type = 'curve'")
    sr.GetBoundingBox x1, y1, w1, h1
    
    For Each s In sr
        For Each n In s.Curve.Nodes
            If n.Selected Then
                n.GetPosition x, y
                Set sLine = ActivePage.Layers("ghide").CreateLineSegment(x + 0.5, y, x + 1, y)
                End If
        Next n
    Next s
End Sub
Best of luck,

-Shelby
Reply With Quote
  #3  
Old 31-08-2011, 07:57
stergema
Guest
 
Posts: n/a
Default

Ok, thanks for deleting it, i did that, but i want to know how to do it the vba way, i know there's a application.onkey for excel, it must be something similar for corel.
Reply With Quote
Reply


Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
Autorun / autostart macro Geert CorelDRAW CS 3 03-03-2006 13:13
Autorun Macro without GlobalDocument_OpenDocument joexx CorelDRAW/Corel DESIGNER VBA 6 16-05-2004 10:54


All times are GMT -5. The time now is 22:26.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com