CPUが１００パーセント

なんやら、WindowsXPがマウスの動きが遅い

マウスパッドを変えてもかわらんとよ

元IT屋のくじらのだんならしくもない言葉

おーと、タスクマネージャを起動したらなんとCPU使用率が１００%

Systemとよぶプロセス・・なんじゃ

ということで『system cpu使用率 高い』ぐぐってみると、

あるわ、あるわ、でも決め手がないまま

おー、イベントログのシステムにエラー『Windows Update Agent』が同時刻に記録

なんや分からんうち直ってもうた、・・・自己修復機能か、さすがWindows

pepoと

Excelへ写真を貼り付けるマクロ２

前回の作品で連続３回続けて写真貼り付けもいいが、セルを指定して一枚ずつ写真を貼り付ける方が自由度があってもいいかも

そこでアクティブセルへ一回限りの写真貼り付けへ改造した、office2007と2003でも確認済みよん

Sub アクティブセルへ写真貼り付け()
Dim vntFileName As Variant
Dim rng挿入先 As Range
Set rng挿入先 = ActiveCell
vntFileName = Application.GetOpenFilename( _
FileFilter:="写真 (*.bmp;*.jpg;*.tif;*.jpeg;*.png),*.bmp;*.jpg;*.tif;*.jpeg;*.png", _
Title:="挿入する写真を選択", MultiSelect:=False)
If VBA.VarType(vntFileName) <> vbString Then Exit Sub
With ActiveSheet.Pictures.Insert(vntFileName)
.Top = rng挿入先.Top
.Left = rng挿入先.Left
.Cut
rng挿入先.Select
' ActiveSheet.PasteSpecial Format:="図 (BMP)", Link:=False, DisplayAsIcon:=False
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 252# 'DSC(Lサイズ相当) 89mm×119mm
Selection.ShapeRange.Width = 337.5 '
Application.CutCopyMode = False
Range("A1").Copy 'クリップボードの画像を消去する為の上書き・ダミーコピー
Application.CutCopyMode = False
End With
End Sub

pepoと

Excelへ写真を貼り付けるマクロ

これはいい！

Excelのワークシートへ写真の挿入、貼り付けが画像をクリックするだけで位置・サイズ調整・圧縮まで行うことが出来るすぐれものマクロ

一度に３枚まで連続操作が出来るが途中でキャンセルできる為一枚でも正常に動作します

Range("A1,A21,A41")　を増やせば３枚以上もOK

Excelを閉じる時にCPUが１００％になり大変遅いため、ダミーのコピー処理を追加してクリップボードを空にしている

以下のオリジナルから改造<m(__)m>

http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200802/08020023.txt

 

Sub 写真貼り付け()
    Dim vntFileName As Variant
    Dim i As Integer
    Dim int総数 As Integer
    Dim rng挿入先 As Range
    Dim rng全挿入先 As Range
    ActiveWindow.Zoom = 100
    Set rng全挿入先 = Range("A1,A21,A41")
    int総数 = rng全挿入先.Areas.Count
    For Each rng挿入先 In Range("A1,A21,A41")
        i = i + 1
        vntFileName = Application.GetOpenFilename( _
            FileFilter:="写真 (*.bmp;*.jpg;*.tif;*.jpeg;*.png),*.bmp;*.jpg;*.tif;*.jpeg;*.png", _
            Title:="挿入する写真を選択 (" & CStr(i) & " of 3)", MultiSelect:=False)
        If VBA.VarType(vntFileName) <> vbString Then Exit For
        With ActiveSheet.Pictures.Insert(vntFileName)
            .Top = rng挿入先.Top
            .Left = rng挿入先.Left
            .Cut
            rng挿入先.Select
'            ActiveSheet.PasteSpecial Format:="図 (BMP)", Link:=False, DisplayAsIcon:=False
            ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
             Selection.ShapeRange.Height = 252# 'DSC(Lサイズ相当) 89×119
             Selection.ShapeRange.Width = 337.5  '
             Selection.ShapeRange.Rotation = 0#
            Application.CutCopyMode = False
            Range("A1").Copy 'クリップボードの画像を消去する為の上書き・ダミーコピー
            Application.CutCopyMode = False
        End With
    Next
End Sub