WSHでクリップボードの内容をpptに貼り付け

 WSHでクリップボードの内容をpptに貼り付け

動作未確認です。

'sub pptpaste

    'On Error resume Next

    Dim objWshShell,PPTapp

    Set objWshShell =WScript.CreateObject("WScript.Shell")

    Set PPTapp=CreateObject("powerpoint.Application")

    'Activate PowerPoint Window

    objWshShell.AppActivate GetProcID("powerpoint.exe")

    'PPTapp.WindowState = 1

    PPTapp.visible=true

    Set PPTPre = PPTapp.ActivePresentation

    ' If there is no presentation, Open new presentation

    If Err.Number <> 0 Then

        Set PPTPre = PPTapp.Presentations.Add

        Set PPTsl = PPTPre.Slides.Add(1, 12)

        Err.Clear

    End If

    If PPTapp.ActiveWindow.Selection.Type = 1 Then

        PPTapp.ActiveWindow.WiewType = 1

        PPTapp.ActiveWindow.WiewType = 9

    End If

   

    now_slno = PPTapp.ActiveWindow.Selection.SlideRange.SlideIndex

   

    Set PPTsl = PPTPre.Slides(now_slno)

    PPTsl.Select

   

 '   Dim w, h

 '   w = PPTPre.PageSetup.Slidewidth

 '   h = PPTPre.PageSetup.SlideHeight

   

'    PPTsl.Shapes.PasteSpecial DataType:=2

     PPTsl.Shapes.Paste

   

    For m = 1 To 600 Step 1

        Wscript.sleep 10

        If PPTsl.Shapes.Count >= zu + 1 Then Exit For

        If m = 400 Then PPTapp.CommandBars.ExecuteMso "PastePicture"

        If m = 590 Then

            Set PPTapp = Nothing: Set PPTPre = Nothing: Set PPTsl = Nothing

            'GoTo myerr:

        End If

    Next

   

    zu = PPTsl.Shapes.Count

'    If PPTsl.Shapes(zu).Width > w - 40 Then PPTsl.Shapes(zu).Width = w - 10

'    If PPTsl.Shapes(zu).Height > h - 70 Then PPTsl.Shapes(zu).Height = h - 70

    PPTsl.Shapes(zu).Left = 4

    PPTsl.Shapes(zu).Top = 61

    If pgdown Then PPTPre.Slides(now_slno + 1).Select

   

   ' PPTapp.Activate

   Set PPTapp = Nothing: Set PPTPre = Nothing: Set PPTsl = Nothing

 '  Exit Sub

WScript.Quit

Function GetProcID(ProcessName)

    Dim Service

    Dim QfeSet

    Dim Qfe

    Dim intProcID

    Set Service = WScript.CreateObject("WbemScripting.SWbemLocator").ConnectServer

    Set QfeSet = Service.ExecQuery("Select * From Win32_Process Where Caption='"& ProcessName &"'")

    intProcID = 0

    For Each Qfe in QfeSet

        intProcID = Qfe.ProcessId

        Exit For

    Next

    GetProcID = intProcID

End Function

JScriptで指定範囲の画面キャプチャ

 Jscriptで指定範囲の画面キャプチャ

同じフォルダにMouseEmulator.dllと設定ファイルPSC1.txtが必要です。

「WSH JScriptを使いこなそう ～マウス操作～」様

http://jscript.zouri.jp/Source/MouseCtrl.html

処理用ファイル

mouse.js

excel = WScript.CreateObject("Excel.Application")

function psc(str)

{

    //API Command for Mouse Control

    var s1 ="rundll32.exe MouseEmulator.dll, _";

    var s2 ="@16";

    var c1 ="SetMouseXY";

    var c2 ="DownLeft";

    var c3 ="UpLeft";

    //Get current mouse position

    var ret = excel.ExecuteExcel4Macro( "CALL(\"user32\",\"GetMessagePos\",\"J\")" );

    var strHex = ("00000000" + ret.toString(16).toUpperCase()).slice(-8);

    var y = parseInt("0x" + strHex.slice(0, 4),16);

    var x = parseInt("0x" + strHex.slice(-4),16);

    //WScript.Echo(x + "_" + y);

    var buf =str.split(",");

    //Send PrintSCreenKey

    excel.ExecuteExcel4Macro( "CALL(\"user32\",\"keybd_event\",\"JJJJJ\",44,121,1,0)" );

    excel.ExecuteExcel4Macro( "CALL(\"user32\",\"keybd_event\",\"JJJJJ\",44,121,3,0)" );

   

    WScript.Sleep( 900 );

    // MouseDrug

    var sh = new ActiveXObject( "WScript.Shell" );

    sh.Run( s1 + c1 + s2 + " "  + buf[0] + "," + buf[1] );

    sh.Run( s1 + c1 + s2 + " "  + buf[0] + "," + buf[1] );  //call twice to avoid errors

    sh.Run(  s1 + c2 + s2);

    WScript.Sleep( 100 );

    sh.Run( s1 + c1 + s2 + " " + buf[2] + "," + buf[3] );

    sh.Run(  s1 + c3 + s2);

    WScript.Sleep( 100 );

    sh.Run( s1 + c1 + s2 + " " + x + "," + y);

    WScript.Sleep( 100 );

    //WScript.Echo( "終了" );

    sh = null;

}

実行ファイル

test.js

理由はわかりませんが、ダブルクリックで実行するとミスりやすいです。ファイルを選択しておいて、エンターキーで実行すると取りこぼしが少ないようです。

a='100,200,300,400'

eval(WScript.CreateObject("Scripting.FileSystemObject").OpenTextFile("mouse.js", 1).ReadAll());

psc(a);

実行ファイル作成用

Set_psc.js

Pythonで画面切り取り

 PythonでPyAutoGUIを入れる方法

Pythonを使うのが初めてで、勘違いしていてうまくいかなかったのでメモ。

Pythonのシェルではなく、DOSプロンプトやPowerShellを使わないといけなかった。

(1)Pythonをインストールする

(2)インストールディレクトリ下に「Scripts」というフォルダがあり、その下にpip.exeがある。

(3)そのフォルダの何もないところを右クリック→「ターミナルで開く」

(4)Power Shellが開くので下記を入力してエンター

～\Programs\Python\Python310\Scripts> .\pip install pyautogui

　 * ￥は実際はバックスラッシュ

エラーが出ずに処理が進めば成功

このへんもインストールしてください。

> .\pip install pywin32

> .\pip install pillow

任意の名前.pyw (実行ファイル)

a="100,200,600,800"

exec(open("00_set_psc.pyw").read()); psc(a)

00_Set_PSC.pyw (メインのスクリプト)

使い方：

(1) Sin+Shift+Sで画面を切り取る

(2) 00_set_psc.pywを実行
　クリップボードの画像のスクリーン上での位置を読み取ります。
　失敗した場合は、手動で座標設定を行います。
　座標を含んだ実行ファイル(～.pyw)を保存します。

(3) 上で作成した実行ファイル(省略時は 01_new.pyw)を実行する
　指定範囲のキャプチャができます

00_set_psc.pyw

import io

import pyautogui

from PIL import ImageGrab, Image

from tkinter import messagebox

from tkinter import filedialog

import win32clipboard

def send_to_clipboard(clip_type, data):

    win32clipboard.OpenClipboard()

    win32clipboard.EmptyClipboard()

    win32clipboard.SetClipboardData(clip_type, data)

    win32clipboard.CloseClipboard()

def psc(a):

    xy = map(int,a.split(","))

    screen_shot = ImageGrab.grab(all_screens=True , bbox=((tuple(xy))))

    try:

        screen_shot.save('02_new.png')

    finally:

        output = io.BytesIO()

        screen_shot.convert('RGB').save(output, 'BMP')

        data = output.getvalue()[14:]

        output.close()

        send_to_clipboard(win32clipboard.CF_DIB, data)

def set_xy():

    msg1a = "Place the cursor at the **"

    msg1b = "** corner of the snipping area and press ENTER key."

    messagebox.showinfo("",  msg1a + "Upper Left" + msg1b)

    x1, y1 = pyautogui.position()

    messagebox.showinfo("", msg1a + "Lower Right" + msg1b)

    x2, y2 = pyautogui.position()

    return  ','.join(map(str,[x1,y1,x2,y2]))

def save_file(xy):

    # Save dialog

    filename = filedialog.asksaveasfilename(

        title = " x1,y1,x2,y2 = " + xy + " (If omitted, the script is saved as 01_new.pyw)",

        filetypes = [("pyw", ".pyw")],

        initialdir = "./",

        defaultextension = "pyw"

    )

    if filename == "":

        filename = "01_new.pyw"

    t1 =f"a='{xy}'\nexec(open('00_set_psc.pyw').read()); psc(a)"

    f = open(filename, 'w')

    f.write(t1)

    f.close()

def get_latest():

    img = ImageGrab.grabclipboard()

    if isinstance(img, Image.Image):

        # print(Save clipboard image to PNG file (not mandatory))

        img.save('02_new.png')

        # print(Serch image location on screen)

        p = pyautogui.locateOnScreen(img)

        # print(Retry in the relieved condition)

        if p==None:

            p = pyautogui.locateOnScreen(img,confidence=0.9)

        if p!=None:

            #print("case1: Success to find the location")

            xy = ','.join(map(str,[p.left,p.top,p.left+p.width,p.top+p.height]))

            save_file(xy)

        else:

            #print("case2: Fail to find the location")

            save_file(set_xy())

    else:

        #print("No image in the clipboard")

        save_file(set_xy())

# If script is executed by itself, execute get_latest()

#print(__file__)

if "00_set_psc" in __file__:

    get_latest()

PyautoGUIのLocateonScreenがマルチモニタに対応していないので対策しておきます。

Qiita：pyautoguiを【超適当に】マルチディスプレイ環境に対応させる Part1 Part2

https://qiita.com/kznSk2/items/a6833c095aec3b8ce72e

https://qiita.com/kznSk2/items/1c756eb4bee80c66233d

上記を参考に

C:\Users\(ユーザー名)\AppData\Local\Programs\Python\Python310\Lib\site-packages\pyscreeze\

__init__.py

を下記のように編集する

下記は必須

ImageGrabに引数all_screens=Trueを渡す

@requiresPillow

def _screenshot_win32(imageFilename=None, region=None):

    """

    TODO

    """

    # TODO - Use the winapi to get a screenshot, and compare performance with ImageGrab.grab()

    # https://stackoverflow.com/a/3586280/1893164

    im = ImageGrab.grab(all_screens=True)

プライマリモニタが左上の人は以下不要。セカンダリモニタがプライマリの左や上にある場合は下記も必要です。

最初のimportセクションで win32apiをインポート

try:

    from PIL import Image

    from PIL import ImageOps

    from PIL import ImageDraw

    if sys.platform == 'win32': # TODO - Pillow now supports ImageGrab on macOS.

        import win32api

        from PIL import ImageGrab

LocateonScreenの出力を編集

def locateOnScreen(image, minSearchTime=0, **kwargs): """TODO - rewrite this minSearchTime - amount of time in seconds to repeat taking screenshots and trying to locate a match. The default of 0 performs a single search. """ start = time.time() while True: try: screenshotIm = screenshot(region=None) # the locateAll() function must handle cropping to return accurate coordinates, so don't pass a region here. retVal = locate(image, screenshotIm, **kwargs) # ここから if not(retVal == None) and sys.platform == 'win32': displays = win32api.EnumDisplayMonitors() left_min = min([display[2][0] for display in displays]) top_min = min([display[2][1] for display in displays]) retVal = Box( left = retVal[0] + left_min, top = retVal[1] + top_min, width = retVal[2], height = retVal[3] ) # ここまで追加分 try:

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

設定用ファイルWSH版

セキュリティ的にも危ないし、そのうちデフォルト無効になってしまうと思いますが、一応載せておきます。

set.vbs

Set Excel = WScript.CreateObject("Excel.Application")

Dim fn, xy1, xy2, str1 , str2, fso

msgbox "カーソルをpoint1に合わせてエンターキーを押してください"

xy1 = API_GetMessagePos

fn = Inputbox( "カーソルをpoint2に合わせてエンターキーを押してください")

xy2 = API_GetMessagePos

str1= "a='" & xy1(0) & "," & xy1(1) & "," & xy2(0) & "," & xy2(1) & "'"

str2="exec(open('scr.py').read()); psc(a)"

If fn="" then fn ="03_new"

Set fso = CreateObject("Scripting.FileSystemObject")

Set tso = fso.CreateTextFile(fn & ".pyw", true)

tso.Write(str1 & vbcrlf & str2)

tso.Close

Function API_GetMessagePos()

    Dim ret, strHex, x, y

    Dim strFunction

    Const API_STRING = "CALL(""user32"",""GetMessagePos"",""J"")"

    strFunction = API_STRING

    ret = Excel.ExecuteExcel4Macro(strFunction)

    strHex = Right("00000000" & Hex(ret), 8)

    x = CLng("&H" & Right(strHex, 4))

    y = CLng("&H" &  Left(strHex, 4))

    API_GetMessagePos = Array(x, y)

End Function

=====以下作業時のメモ========

エクセルを前面に出してクリップボードから貼り付け、サイズと位置変更

import win32gui

import win32com.client

def excel_paste(a):

    xy = a.split(",")

    # Activate Excel

    memoapp = win32gui.FindWindow(None,'Excel')

    win32gui.SetForegroundWindow(memoapp)

    # set Excel application

    xl_app = win32com.client.GetObject(Class='Excel.Application')

    xl_app.Visible = True

    # Paste

    active_sheet = xl_app.ActiveSheet

    active_sheet.Paste()

    Sh = xl_app.ActiveSheet.Shapes(active_sheet.Shapes.Count)

    #change size

    Sh.Left = xy[0]

    Sh.Top = xy[1]

    Sh.Width = xy[2]

PowerPointを前面に出して貼り付け、位置変更（動作未確認）

import win32gui

import win32com.client

def ppt_paste(a):

    xy = a.split(",")

    # Activate ppt

    memoapp = win32gui.FindWindow(None,'PowerPoint')

    win32gui.SetForegroundWindow(memoapp)

    # set power point application

    pp_app = win32com.client.GetObject(Class='PowerPoint.Application')

    pp_app.Visible = True

    # If Slide index pain is selected

    if (pp_app.ActiveWindow.Selection.Type == 1):

        pp_app.ActiveWindow.WiewType = 1

        pp_app.ActiveWindow.WiewType = 9

    # get current slide number

    now_slno = pp_app.ActiveWindow.Selection.SlideRange.SlideIndex

    sld = pp_app.ActiveWindow.Slides(now_slno)

    # paste

    sld.Paste()

    #change size

    Sh = sld.Shapes(sld.Shapes.Count)

    Sh.Left = xy[0]

    Sh.Top = xy[1]

    Sh.Width = xy[2]

paste.pyw (実行ファイル)

a="100,200,400"

exec(open("scr.py").read()); ppt_paste(a)