[[20200217163728]] 『Excelにスクショを自動的に張り付けたい』(さはら) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『Excelにスクショを自動的に張り付けたい』(さはら)

一枚目のスクショをA1のセルに張り付けて、
二枚目以降のセルは一枚目のスクショから
2行ほどずらして張り付けたいです。
以下のコードを参考にしましたが、解決せず。。
御教示頂けませんでしょうか?

以下元のコードです。

Private isLogging As Boolean

' キャプチャを貼り付けるブック名を保持する
Private fileName As String

' キャプチャを取得する
Private Sub Capture()

  On Error Goto errorHandler

  ' クリップボードに画像が格納されていたら貼り付ける
  If Application.ClipboardFormats(1) = xlClipboardFormatBitmap Then
    Dim rows As Integer : rows = 54  ' 行数
    Dim cols As Integer : cols = 72  ' 列数

    ' キャプチャを貼り付けるブックを選択する
    Workbooks(fileName).Activate

    ' 選択しているセルを基準セルとして取得する
    Dim baseCell As Variant
    Set baseCell = Selection

    ' 下線を引く
    Range(baseCell.Offset(rows, 1), baseCell.Offset(rows, cols + 1)).Select
    With Selection.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous
      .Weight = xlThin
    End With

    ' 見出し用の記号をセットする
    baseCell.Offset(2, 2).Value = "■"

    ' キャプチャ取得日時をセットする
    With baseCell.Offset(2, cols - 1)
      .HorizontalAlignment = xlRight
      .Value = "取得日時:" & Now
    End With

    ' クリップボードのデータを貼り付け、行数に合わせて縮小する
    baseCell.Offset(4, 3).Select
    ActiveSheet.Paste
    With Selection.ShapeRange
      .LockAspectRatio = msoTrue
      .Height = .Height * 0.7
    End With

    ' 次の画像を貼るために基準セルを移動し、クリップボードに現在のセルの値をコピーする (先頭を Bitmap でなくすため)
    With baseCell.Offset(rows + 1, 0)
      .Select
      .Copy
    End With

    ' 切り取り・コピーモードを解除する
    Application.CutCopyMode = False

    ' 改ページ設定をする
    ActiveSheet.HPageBreaks.Add Before:=ActiveCell
  End If

  ' 1秒間隔で再実行するようタイマーをセットする
  Application.OnTime Now + TimeValue("00:00:01"), "Capture", , isLogging

  Exit Sub

errorHandler:

  isLogging = False

End Sub

' キャプチャを開始する
Sub StartCapture()

  MsgBox "キャプチャの取得を開始します。終了時は Esc キーを押下してください。"

  ' Esc キーで停止できるようにしておく
  Application.OnKey "{ESC}", "StopCapture"

  ' キャプチャを貼り付けるブック名を取得する
  fileName = ActiveWorkbook.Name

  ' キャプチャ取得状態を設定する
  isLogging = True

  ' キャプチャの取得を開始する
  Capture
End Sub

' キャプチャを終了する
Sub StopCapture()

  If isLogging = True Then
    ' キャプチャの取得状態を解除する
    isLogging = False

    ' Esc キーへの登録を解除する
    Application.OnKey "{ESC}", ""

    MsgBox "キャプチャの取得を停止しました。"
  End If
End Sub

< 使用 Excel:Excel2010、使用 OS:unknown >


これだけのコードを書いた人が、何をつまらない質問をしているのでしょう? A1セルから出力するなら、Offsetを止めて、セル指定にするだけじゃないですか? バカにしているのでしょうか?

それとも、自分で書いたのではないならば、出典元を明らかにしてください。 他人のコードを、あたかも自分のコードのように公開する事は、著作権違反になりますよ。

そして2行ずらすのは、貼った最後の画像のBottomRightCellプロパティを見るだけかと。
(???) 2020/02/17(月) 17:20


 参考HPです。 

https://qiita.com/tennisplayer8083tanakatarou/items/b383ed020db656fb8863
(通りすがり) 2020/02/17(月) 17:31


なるほど、誰かが改変したものをベースにせず、大元を使っていれば、ほぼそのままで希望通りだったのですねぇ。 +1 を +2 等にするだけだし。
(???) 2020/02/17(月) 17:52

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.