オフラインの行の高さに基づいて行の範囲を選択

Question

少し背景がありますが、複数のExcelファイルから取得したVBSコードをWord文書に貼り付けてレポートを作成しています。しかし、私はそれらの結合された行の高さに基づいて行の範囲を選択できるようにする必要があります。その理由は、グラフをコピーして絵として単語に貼り付けるので、コードは他のExcelファイルを開き、そのデータを選択し、そのグラフの下の絵として単語に貼り付けてから、ループするまで続けますそれはすべてのファイルを通過しました。使用される行の範囲がこれよりも大きい行の高さを持つ場合、グラフの下に通常のサイズの8行（14.3）または合計行の高さ114.4を収めることができ、次のページに移動する必要があります。

私が今使っているのは、コードが使用範囲を調べ、8行を超える場合は使用範囲を選択して次のページに貼り付けます。使用範囲が8未満の場合は選択します空白であっても合計8行が貼り付けられ、レポート全体に均一に見えるように貼り付けられます。しかし、8行分未満のデータがあるのに、すべてのテキストに合わせて1行または2行を増やさなければならない場合があります（列幅は、ワード文書に収まるように設定された領域があるため固定する必要があります）そのため、8行の合計行高さが114.4より大きくなり、もはやグラフの下に収まらなくなります。この場合は、行の高さが114.4で、8行ではなく、それに基づいて選択する必要があります。

多くの必要な助けを得るために必要なことを説明してくれることを願っています。以下は、行の高さに基づいてデータを選択しようとする私の現在の試みです...それはエラーなしでコードを実行しますが、使用される範囲から外れるだけです。行の高さを参照するコードを取得できません何か、それはちょうどそのコードを無視する場合です。

Sub Events(f) 
    Set objWkb3 = objExcel.Workbooks.Open(f) 
    LastRowEvents = objWkb3.Sheets("Events").usedRange.Rows.Count 
    LastRowEvents1 = objWkb3.Sheets("Events").usedRange.Rows 
    LastRowEvents2 = objWkb3.sheets("Events").usedRange.RowHeight 
    LastRowEvents3 = objWkb3.sheets("Events").Range("F1:F8").RowHeight 


    'Selection of Events 
    If LastRowEvents > 8 then 
    objWkb3.Sheets("Events").Range("A1:F" & LastRowEvents).CopyPicture 
    objWord1.Selection.TypeParagraph 
    objWord2.Selection.TypeParagraph 
    Elseif LastRowEvents2 > 114.4 then 
    objWkb3.Sheets("Events").Range("A1:F" & LastRowEvents).CopyPicture 
    objWord1.Selection.TypeParagraph 
    objWord2.Selection.TypeParagraph 
    Elseif LastRowEvents2 = 114.4 then 
    objWkb3.Sheets("Events").Range("A1:F" & LastRowEvents).CopyPicture 
    Else objWkb3.Sheets("Events").Range("A1:F8").CopyPicture 
    End If 

    'Events to PJR 
    wsh.sleep 1500 
    objWord1.Selection.Paste 
    objWord1.Selection.MoveRight 
    objWord1.Selection.TypeParagraph 

    'Events to Gas 
    objWord2.Selection.Paste 
    objWord2.Selection.MoveRight 
    objWord2.Selection.TypeParagraph 

    'objWkb3.Save 
    objWkb3.Close(0) 
End Sub 

Answer 1

私は私が望んでたかのコードの仕事を得ることができた.Heightする.RowHeightを変更することで、遊んと異なるものをしようとしています。

Sub Events(f) 
    Set objWkb3 = objExcel.Workbooks.Open(f) 
    LastRowEvents = objWkb3.Sheets("Events").usedRange.Rows.Count 
    LastRowEvents1 = objWkb3.Sheets("Events").usedRange.Rows 
    LastRowEvents2 = objWkb3.sheets("Events").usedRange.Height 
    LastRowEvents3 = objWkb3.sheets("Events").Range("A1:F8").Height 
    MRow1 = Round(((114.4 - LastRowEvents2)/14.3),0) 
    MRowT = MRow1 + LastRowEvents 

    'Selection of Events 
    If LastRowEvents > 8 then 
    objWkb3.Sheets("Events").Range("A1:F" & LastRowEvents).CopyPicture 
    objWord1.Selection.TypeParagraph 
    objWord2.Selection.TypeParagraph 
    Elseif LastRowEvents2 > 114.4 then 
    objWkb3.Sheets("Events").Range("A1:F" & LastRowEvents).CopyPicture 
    objWord1.Selection.TypeParagraph 
    objWord2.Selection.TypeParagraph 
    Elseif LastRowEvents2 = 114.4 then 
    objWkb3.Sheets("Events").Range("A1:F" & LastRowEvents).CopyPicture 
    Elseif LastRowEvents3 > 114.4 then 
    objWkb3.Sheets("Events").Range("A1:F" & MRowT).CopyPicture 
    Elseif LastRowEvents3 = 114.4 then 
    objWkb3.Sheets("Events").Range("A1:F" & LastRowEvents).CopyPicture 
    Else objWkb3.Sheets("Events").Range("A1:F8").CopyPicture 
    End If 

    'Events to PJR 
    wsh.sleep 500 
    objWord1.Selection.Paste 
    objWord1.Selection.MoveRight 
    objWord1.Selection.TypeParagraph 

    'Events to Gas 
    objWord2.Selection.Paste 
    objWord2.Selection.MoveRight 
    objWord2.Selection.TypeParagraph 

    'objWkb3.Save 
    objWkb3.Close(0) 
End Sub