Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

Register Log in

how to take a screenshot for a selected area using vba Catia V5 4

Status
Not open for further replies.
KABEL

KABEL

Automotive
Dec 10, 2018
29
0
0
MA
Hi everybody,

I’m working on project in catia V5 using vba, in this project I want to achieve those things :
I want to use a userform with two buttons:

[ul]
[li]the first one is reserved to appear the Capture toolbox (picture below)
toolbox_ffqxga.png

,Then wait for the user to select the area that he want to be captured (using the select mode : picture below).
select_mode_talgic.png
[/li]
[/ul]

[ul]
[li]The second one will allow the user to take a screenshot for the selected area.(picture bellow)
selected_area_q86lrp.png
[/li]
[/ul]

My problem is when I (click on the second button) take a screenshoot (using vba),the captured picture is not focused on the selected area (all the window is included at the picture ).

Any hint is really appreciated
Regards,
 
Replies continue below

Recommended for you

Sort by date Sort by votes
iscariot
yeah, I've been spending days trying to solve this issue.

catiavbmacro
I want to give the user the possibility to select an area that he desire to be captured, then with the second button I have to take a picture of that area because I'll include this picture in a generated report I've created (with the vba code) (excel file) , you see that's why even the zoom option wont work for me.
 
Upvote 0 Downvote
Hi ferdo,
thank you, I really appreciate the way you help others ,
using the snipping tool sames to be a good way to solve this problem, that what I did :

Code: 
Public wsh As Object
   Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
     (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long

   Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
     (ByVal hwnd As Long, ByVal lpString As String, _
     ByVal aint As Long) As Long
   Declare Function GetWindow Lib "user32" _
     (ByVal hwnd As Long, ByVal wCmd As Long) As Long

   Declare Function EnumWindows Lib "user32" _
     (ByVal wndenmprc As Long, ByVal lParam As Long) As Long

   Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
     (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
     lParam As Any) As Long
     
   Public Declare Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)

   Private Const WM_CLOSE = &H10
   Private Const GW_HWNDFIRST = 0
   Private Const GW_HWNDLAST = 1
   Private Const GW_HWNDNEXT = 2
   Private Const GW_HWNDPREV = 3
   Private Const GW_OWNER = 4
   Private Const GW_CHILD = 5
   Private Const GW_MAX = 5
   Private mstrTarget As String
   Private mblnSuccess As Boolean
   
Public Function EnumCallback(ByVal app_hWnd As Long, ByVal param As Long) As Long
   Dim buf As String * 256
   Dim title As String
   Dim length As Long
   ' Checks a returned task to determine if App should be closed
   ' get window's title.
   length = GetWindowText(app_hWnd, buf, Len(buf))
   title = Left$(buf, length)
   ' determine if target window.
   If InStr(UCase(title), UCase(mstrTarget)) <> 0 Then
      ' Kill window.
      SendMessage app_hWnd, WM_CLOSE, 0, 0
      mblnSuccess = True
   End If
   ' continue searching.
   EnumCallback = 1
End Function
   
Public Function blnCloseWindow(strApplicationTitle As String) As Boolean

   ' retrieve Windows list of tasks.
   mblnSuccess = False
   mstrTarget = strApplicationTitle
   EnumWindows AddressOf EnumCallback, 0
   blnCloseWindow = mblnSuccess

End Function

[COLOR=#EF2929]Private Sub CommandButton1_Click()
Set wsh = VBA.CreateObject("WScript.Shell") 
wsh.Run "C:\Windows\sysnative\SnippingTool.exe"
End Sub[/color]

[COLOR=#729FCF]Private Sub CommandButton2_Click()
AppActivate "Outil Capture"
SendKeys "^C"
[COLOR=#73D216]blnCloseWindow "Outil Capture"
Sleep 500
SendKeys "{TAB}"
SendKeys "{ENTER}"[/color]
Dim AppliExcel As Object
Set AppliExcel = CreateObject("Excel.Application") AppliExcel.Workbooks.Add AppliExcel.Visible = True With AppliExcel.ActiveSheet
    .Range("C6:G12").Select
    .Paste
End With

End Sub[/color]

everything works fine except for the green line ,they don't close the snipping tool, Please is there any away to close the snipping tool.
thank you again,
Regards,
 
Upvote 0 Downvote
Thank you again Ferdo,

now everything works fine, I found this to way to kill the snipping tool :

Code: 
Sub TerminateApp()
     '---------------------------------------------------------------------------------------
     ' Terminates the exe process specified.
     ' Uses WMI (Windows Management Instrumentation) to query all running processes
     ' then terminates ALL instances of the exe process held in the variable strTerminateThis.
     '---------------------------------------------------------------------------------------

Dim strTerminateThis As String 
'The variable to hold the process to terminate

Dim objWMIcimv2 As Object, objProcess As Object, objList As Object
Dim intError As Integer

'Process to terminate – you could specify and .exe program name here

strTerminateThis = [COLOR=#EF2929]"bc-wedge.exe"[/color] [COLOR=#73D216]'===> here I specify the app that I want to Kill (in my case: snipping tool)[/color]

'Connect to CIMV2 Namespace and then find the .exe process

Set objWMIcimv2 = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objList = objWMIcimv2.ExecQuery("select * from win32_process where name='" & strTerminateThis & "'")
For Each objProcess In objList
            intError = objProcess.Terminate 'Terminates a process and all of its threads.
             'Return value is 0 for success. Any other number is an error.
            If intError <> 0 Then Exit For
Next

'ALL instances of exe (strTerminateThis) have been terminated
Set objWMIcimv2 = Nothing
Set objList = Nothing
Set objProcess = Nothing

End Sub

yes before closing the snipping tool , I copy the content (image) using the sendkeys "^C" , (ctr+C)

Regards,
 
Upvote 0 Downvote
ferdo
I really appreciate your help, thank you veryy much ,
have a nice week end, [thumbsup2]

hi CAD2015
thank you for the suggestion , unfortunately I'm on win 7 [pc1].
 
Upvote 0 Downvote
And here it is the CATIA 3DEXPERIENCE version [bigsmile]

Profile_Creation_in_3DEx_vba_bovdub.gif


I used your TerminateApp sub and my main sub is here

Code: 
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal milliseconds As LongPtr) 'MS Office 64 Bit

Sub Catmain()

'MsgBox "You have 5 sec to grab your screen region"

Set wsh = VBA.CreateObject("WScript.Shell")
wsh.Run "c:\Windows\System32\SnippingTool.exe"

Sleep 5000

Dim FileSys
Set FileSys = CATIA.FileSystem

Dim xlApp
Set xlApp = CreateObject("Excel.Application")

Dim mydoc
Set mydoc = xlApp.Workbooks.Open("c:\temp\Report.xlsx")

xlApp.Visible = True

With xlApp.ActiveSheet
    .Range("C6").Select
    .Paste
End With

TerminateApp

End Sub

Regards
Fernando

- Romania
- EU
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

kevEur
  • Question
Catia V5 - CaptureToFile in VBA
Replies
4
Views
30
kevEur
kevEur
W
  • Question
How to Define Circle Edges for Points in CATIA VBA?
Replies
0
Views
1
wealnut
W
xPAIVAx
  • Question
How to measure ejector pins in CATIA V5
Replies
11
Views
33
Little Cthulhu
Little Cthulhu
Shahee
  • Locked
  • Question
How to get document path from broken product using CATIA V5 CAA
Replies
1
Views
15
Little Cthulhu
Little Cthulhu
Sidtha
  • Locked
  • Question
How to get the Balloon Position from CATIA V5 Drawings using VBA
Replies
17
Views
51
itsmyjob
itsmyjob
Back
Top