【最大10000ポイント】当たる!!質問投稿キャンペーン!

Excelのシートは、見出しを固定にし、表があり、最後に合計となっています。
複数ページにまたがる場合は、最後のページに合計を印刷するので、データが表をオーバーする場合、行の挿入を行いたいのです。
方法はありますでしょうか?

このQ&Aに関連する最新のQ&A

A 回答 (3件)

Selection.Insert Shift:=xlDown


の部分を
Ws.Rows("2:2").Insert Shift:=xlDown
と変更してください。

動作確認はしました。
    • good
    • 0
この回答へのお礼

出来ました!
本当にありがとうございました。

お礼日時:2004/01/09 17:43

検証しませんが、おそらく動作すると思います。


Private Function Excel_Out(WorkTable As String) As Boolean
  Dim Ex As Excel.Application 'エクセルリンク用変数(App)
  Dim Wb As Excel.Workbook 'エクセルリンク用変数(App)
  Dim Ws As Excel.Worksheet 'エクセルリンク用変数(App)
  Dim Cnt As Long
  Dim PageCnt As Long
  Dim strSQL As String
  Dim oRs As Recordset
  Dim RecCnt As Long
  Dim i As Long
  Dim FileName As String
  Dim FileNameS As String


  On Error GoTo Excel_Out_Err

  FileName = "C:TEST_MOTO.xls"
  FileNameS = "C:\TEST.xls"
  Excel_Out = False

  DoCmd.Hourglass True

  'エクセルシートオープン
  Set Ex = New Excel.Application
  Set Wb = Ex.Workbooks.Open(FileName)
  Ex.DisplayAlerts = False
  Set Ws = Wb.Worksheets("Sheet1")

  'ワークテーブルのオープン
  strSQL = ""
  strSQL = strSQL & "Select * From " & WorkTable
  Set oRs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
  RecCnt = oRS.RecordCount
  
  InsCnt = RecCnt - X ←ここでインサートに必要な行数を計算してください。
  for i = 1 to InsCnt
    Ws.Rows("2:2").Select ←インサート行う位置の指定です。
    Selection.Insert Shift:=xlDown
  Next i
  
  Do Until oRs.EOF
    Cnt = Cnt + 1
    Ws.Cells(Cnt, 1) = oRs.Fields("A").Value
    Ws.Cells(Cnt, 2) = oRs.Fields("B").Value
    Ws.Cells(Cnt, 3) = oRs.Fields("C").Value
      ・
      ・
      ・
    oRs.MoveNext
  Loop
  oRs.Close
  Set oRs = Nothing

  Wb.SaveAs FileNameS
  Ex.DisplayAlerts = True
  Wb.Close
  Ex.Quit
  Set Ws = Nothing
  Set Wb = Nothing
  Set Ex = Nothing
  
  Excel_Out = True
  Exit Function
Excel_Out_Err:
  Excel_Out = False
End Function

この回答への補足

回答ありがとうございます。
早速実行してみましたが、
Selection.Insert Shift:=xlDown
のところで、
実行時エラー'424'
オブジェクトが必要です
のメッセージが表示されます。
ここは、そのまま代用したのですが、何か変更するところがあったのでしょうか?
オブジェクトはどこに、どのオブジェクトをつけたらいいのでしょうか?
Selectionの前に、ワークシートのオブジェクトをつけてみましたが、
実行時エラー'438'
オブジェクトはこのプロパティまたはメソッドをサポートしていません。
のメッセージが表示されました。

補足日時:2004/01/09 16:44
    • good
    • 0

モデファイして、お使いください。



Private Function Excel_Out(WorkTable As String) As Boolean
  Dim Ex As Excel.Application 'エクセルリンク用変数(App)
  Dim Wb As Excel.Workbook 'エクセルリンク用変数(App)
  Dim Ws As Excel.Worksheet 'エクセルリンク用変数(App)
  Dim Cnt As Long
  Dim PageCnt As Long
  Dim strSQL As String
  Dim oRs As Recordset
  Dim FileName As String
  Dim FileNameS As String


  On Error GoTo Excel_Out_Err

  FileName = "C:TEST_MOTO.xls"
  FileNameS = "C:\TEST.xls"
  Excel_Out = False

  DoCmd.Hourglass True

  'エクセルシートオープン
  Set Ex = New Excel.Application
  Set Wb = Ex.Workbooks.Open(FileName)
  Ex.DisplayAlerts = False
  Set Ws = Wb.Worksheets("Sheet1")

  'ワークテーブルのオープン
  strSQL = ""
  strSQL = strSQL & "Select * From " & WorkTable
  Set oRs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

  Do Until oRs.EOF
    Cnt = Cnt + 1
    Ws.Cells(Cnt, 1) = oRs.Fields("A").Value
    Ws.Cells(Cnt, 2) = oRs.Fields("B").Value
    Ws.Cells(Cnt, 3) = oRs.Fields("C").Value
      ・
      ・
      ・
    oRs.MoveNext
  Loop
  oRs.Close
  Set oRs = Nothing
  Cnt = Cnt + 1
  Ws.Cells(Cnt, 1) = "=SUM(A1:A" & Cnt & ")"
  Ws.Cells(Cnt, 2) = "=SUM(B1:B" & Cnt & ")"
  Ws.Cells(Cnt, 3) = "=SUM(C1:C" & Cnt & ")"
    ・
    ・
    ・
  Wb.SaveAs FileNameS
  Ex.DisplayAlerts = True
  Wb.Close
  Ex.Quit
  Set Ws = Nothing
  Set Wb = Nothing
  Set Ex = Nothing
  
  Excel_Out = True
  Exit Function
Excel_Out_Err:
  Excel_Out = False
End Function

この回答への補足

回答ありがとうございます。
私の説明が下手ですいません。
Excelのシートにはレイアウトが設定してあるために、それを生かしてつくりたいと思っています。
データをExcelに書き込むところまでは、出来ているのですが、行数が超えた場合に、現状では合計の行を上書きしてしまっています。
表の最後と合計との間にデータを追加したいのです。
1命令で行の挿入とかってできないのでしょうか?
ExcelのVBAには行の挿入がありますよね?
ACCESSのVBAからExcelのVBAを呼び出すとかも出来ないのでしょうか?

補足日時:2004/01/09 12:31
    • good
    • 0

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qアクセスからエクセルのシートを追加して、名前をつける方法

アクセス2000で、ある所定の条件を満たした時に、規定の場所にあるエクセルファイルの先頭から2番目に空のワークシートを追加し、そのシート名を変数に格納されている値でリネームしようとしております。結構急務なんですが、excel.application~等使っても出来ませんでした・・・。プロフェッショナルな方、誰か方法を教えていただけないでしょうか?よろしくお願いします。

Aベストアンサー

こんにちは。

急ぎということで、取り急ぎで作ったコードです。目的の処理以外は一切おこなっていませんので、カスタマイズしてください。

また、処理速度の点で実行時バインドではなく、参照設定を予め行って下さい。


Option Compare Database

'要参照設定:Microsft Excel x.x Object Library
Sub AddXLWorksheet()

  Dim xlApp As Excel.Application
  Dim WB As Excel.Workbook
  Dim SH As Excel.Worksheet
  Dim strXLfile as stirng

  strXLfile = "C:\TEST.xls" 'Excelブックフルパス

  Set xlApp = Excel.Application
  With xlApp
    .Visible = True
    Set WB = .Workbooks.Open(strXLfile)
    'シートを3番目に追加
    Set SH = .Worksheets.Add(After:=WB.Worksheets(2))
    'シート命名
    SH.Name = "aaaaa" 'ここを変数で渡せば良い
  End With

  Set SH = Nothing
  Set WB = Nothing
  Set xlApp = Nothing

End Sub

こんにちは。

急ぎということで、取り急ぎで作ったコードです。目的の処理以外は一切おこなっていませんので、カスタマイズしてください。

また、処理速度の点で実行時バインドではなく、参照設定を予め行って下さい。


Option Compare Database

'要参照設定:Microsft Excel x.x Object Library
Sub AddXLWorksheet()

  Dim xlApp As Excel.Application
  Dim WB As Excel.Workbook
  Dim SH As Excel.Worksheet
  Dim strXLfile as stirng

  strXLfile = "C:\TEST.xls" 'Excel...続きを読む

QAccess-VBAでExcelファイルを作成する。

こんにちわお世話になります。

「Excelにエクスポート」ボタンをクリックすると、Inputboxか何かが表示されて、Pathやファイル名やシート名を入力し、「実行」ボタンを押すと、新規にExcelのBookを、そのPath、ファイル名、シート名で作成する。その後、そのシートにデータを書き込むという作業をしたいのです。
AccessのデータをExcelの任意のシートを開いて書き込むという部分のVBAコードはわかりますので、新規Book作成部分のコードがわかるかたお願いします。
Office97を使用しています。

Aベストアンサー

プロジェクト→参照設定でMicrosoft Excel *.* ObjectLibraryにチェックを入
れて下さい。

オブジェクトへの参照を格納する変数を事前バインディング。
変数にオブジェクトの参照を代入します。Addメソッドを使って新規workbookと
worksheet オブジェクトを作成します。
値を代入し名前を付けて保存してオブジェクトを開放する。という流れで良いと
思います。

Private Sub Command1_Click()

  On Error Resume Next

  Dim xlApp  As Excel.Application
  Dim xlBook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet

  Set xlApp = CreateObject("Excel.Application")
  Set xlBook = xlApp.Workbooks.Add
  Set xlSheet = xlBook.Worksheets(1)

  ' Excel のセルに値を代入します。
  xlSheet.Cells(1, 1).Value = " "

  ' Worksheet を名前をつけて保存します。ダイアグボックス等を使用して
   パスやBook名など入力できるようにしてもOKです。
  xlSheet.SaveAs "c:\Temp.xls"

  xlApp.Quit

  Set xlSheet = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing
End Sub

こんな感じでしょうか。

プロジェクト→参照設定でMicrosoft Excel *.* ObjectLibraryにチェックを入
れて下さい。

オブジェクトへの参照を格納する変数を事前バインディング。
変数にオブジェクトの参照を代入します。Addメソッドを使って新規workbookと
worksheet オブジェクトを作成します。
値を代入し名前を付けて保存してオブジェクトを開放する。という流れで良いと
思います。

Private Sub Command1_Click()

  On Error Resume Next

  Dim xlApp  As Excel.Application
  Dim xlBook As Excel.Workbook
...続きを読む

QVBAで行コピーして挿入

1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).Select
  Selection.Insert Shift:=xlDown
  Selection.EntireRow.Hidden = False
Next i

どういう結果を求めたいかというと、たとえば、
SHEET2のA10セル上で、このマクロを実行し、 "挿入行 = 3" と指定したら

A10:   =SHEET1!$A10
A11:   =SHEET1!$A11
A12:   =SHEET1!$A12

となってほしかったのですが、結果は、

A10:   =SHEET1!$A10
A11:   =SHEET1!$A10
A12:   =SHEET1!$A10

となってしまいました。

どうにか、求める結果を得られるようにできないでしょうか?

1行目の内容をコピーして、他の場所に指定数分だけ
挿入するマクロを作りました。

そのマクロ自体は、正しく動いたのですが、コピー元の1行目に
他のシートを参照する関数が入っていた場合、想定どおりの
結果を得ることができません。

[SHEET1:データのみを記載]
省略

[SHEET2]
A1セル:   =SHEET1!$A1 ←コピー元の行

[マクロ:一部抜粋]
myR = Application.InputBox("挿入する行数を入れてください", , "1")

For i = 1 To myR
  Rows("1:1").Copy
  Cells(ActiveCell.Row, 1).S...続きを読む

Aベストアンサー

Active.Cellが同一の位置なのだから相対変位しません。

一例です。(ループは不要なので削除しました)
myR = Application.InputBox("挿入する行数を入れてください", , "1")
Rows("1:1").Copy
Rows(ActiveCell.Row & ":" & ActiveCell.Row + myR - 1).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False

QAccessのRefresh・Requery・Repaintの違い

Requeryはもう一度ソースレコード(テーブル)を読み込むようです。このとき、テーブルの先頭レコードに移動してしまいます。
Refreshは最新のレコード(テーブル)を再表示するような気がします。レコードの移動は起こらない気がします。
Repaintは、VBAでキャプションなどを変更したとき使っています。
でも、よくわかっていません。
どんなときにどんなメソッドを使えばいいのでしょうか?
詳しい方、よろしくお願いいたします。

Aベストアンサー

たびたびすみません。
調べてたらこんなのがでてきました。
http://www.nurs.or.jp/~ppoy/access/access/acF007.html

参考URL:http://www.nurs.or.jp/~ppoy/access/access/acF007.html

QACCESSのVBで、エクセルファイルの最終行を取得

題名の通り
ファイルの最終行を知りたいのです
ざっと
エクセルファイルをオープンするは下記のように
すると思いますが
その後、最終行を取得するのに、どうするのか
教えてください
ーーーーーーーーー------------
Set Xls = GetObject("エクセルのファイル")
Xls.Application.Windows(1).Visible = True
Xls.Application.worksheets("Sheet1").Activate

Aベストアンサー

Xls.Application.worksheets("Sheet1").Rows.Count

を使用するのが一般的なようです。

QACCESSで空白のデーターをクエリで判定/識別する方法を教えてくださ

ACCESSで空白のデーターをクエリで判定/識別する方法を教えてください。
EXCELでは空白を""で判定/識別表していますがACCESSではどうなるのでしょうか。

下の例はフィールドに試験番号があればその番号を、空白なら”欠席”と表示しようとしています。
IIf(([試験番号]="空白の場合何を入れる?"),[試験番号],"欠席")

Aベストアンサー

もうひとつの書き方は
式1: IIf([試験番号] Is Not Null,[試験番号],"欠席")
第2、第3引数の、質問の順序にあわせるとこうなる。

QAccessからExcelを編集

Access2003からExcelを編集したいのですが、
いろいろとWebで見ているのですが、よくわかりません。

例えば、
AccessからTEST.xlsのシート「データ」のA10のセルに「てすと」と入れるとします。
最後に上書きします。

申し訳ありませんが、わかる方、教えて下さい。

Aベストアンサー

「よくわからない」 という感想に怖さを感じます。。。
はたしてここで質問しても理解できるんだろうか、やりたい事のコードだけ利用して終わりってことになりゃしないだろうか、と。。。

Sub hoge()
  Dim xlApp As Object
  Set xlApp = CreateObject("Excel.Application")
  xlApp.Visible = True

  Dim wbk As Object
  Set wbk = xlApp.Workbooks.Open("D:\test\TEST.xls")

  Dim sht As Object
  Set sht = wbk.Worksheets("データ")

  sht.Cells(10, 1).Value = "てすと"

  wbk.Save
  wbk.Close
  xlApp.Quit
End Sub

QAccess エクセルシート名変更

お世話になります。
WindowsXPでAccess2002を使用しているのですが、AccessVBAを使い特定のエクセルシートのシート名を変更したいと考えているのですが、いろいろ方法を検索しているのですが、そのような事例を発見する事ができませんでした。

引き続き調べて行きますが、良い方法がありましたら、ご教授いただけないでしょうか。
宜しくお願いします。

Aベストアンサー

Excelがインストールされている環境なら
CreateObjectやNewでExcel.Applicationオブジェクトを作成して
その上で Bookを読み込み Worksheetの名前を変更すればいいのでは

sub Macro1()
Dim oXL as Object
Dim oWB as Object
Dim oSH as Object]
  Set oXL = CreateObject("Excel.Application")
  Set oWB = oXL.WorkBooks.Open("ブックのファイルパス")
  Set oSH = oWB.Worksheeets("シート名")
  oSH.Name = "変更後のシート名"
  oWB.Save
  oWB.Close
  oXL.Quit
  Set oSH = nothing
  Set oWB = nothing
  Set oXL = nothing
End Sub
といった具合でしょう

QACCESSのVBAにてExcelのシートをコピーしたい

入庫.xlsに現在、"原紙"というシートがあります。
入庫.xlsには、"原紙"と入庫のあった日のシートがあるようにしたいのです。
今日、入庫があれば、入庫.xlsには
"原紙"と"20"のシートが存在するようにしたいのです。
AccessのVBAにて1文でシートのコピーってできないでしょうか?
Dim oApp As Object
Dim StWk1 As String
Dim SHizk As String
Dim Hizk As Integer
Hizk = DatePart("d", Me![入庫日付])
SHizk = CStr(Hizk)
StWk1 = "c:入庫.xls"
Set Xls = GetObject(StWk1)
Xls.Application.Windows(1).Visible = True
Xls.Application.worksheets("原紙").Copy After:=Xls.Application.worksheets(SHizk)
Xls.Application.worksheets(SHizk).Activate

上記のように作成してみたのですが、実行すると、
Xls.Application.worksheets("原紙").Copy After:=Xls.Application.worksheets(SHizk)
のところで、エラーになります。
実行エラー'9':
インデックスが有効範囲にありません。
のメッセージが表示されます。
教えてください。

入庫.xlsに現在、"原紙"というシートがあります。
入庫.xlsには、"原紙"と入庫のあった日のシートがあるようにしたいのです。
今日、入庫があれば、入庫.xlsには
"原紙"と"20"のシートが存在するようにしたいのです。
AccessのVBAにて1文でシートのコピーってできないでしょうか?
Dim oApp As Object
Dim StWk1 As String
Dim SHizk As String
Dim Hizk As Integer
Hizk = DatePart("d", Me![入庫日付])
SHizk = CStr(Hizk)
StWk1 = "c:入庫.xls"
Set Xls = GetObject...続きを読む

Aベストアンサー

Private Sub CmdCopySheet_Click()
  
  'Dim xlApp As Excel.Application
  'Dim xlBook As Excel.Workbook
  'Dim xlSheet As Excel.Worksheet
  Dim xlApp As Object
  Dim xlBook As Object
  Dim xlSheet As Object
  Dim stFileName As String
  Dim stSheetName As String
  Dim lngCnt As Long
  
  'ファイル名指定
  stFileName = "C:\入庫.xls"
  
  'コピーシート名指定
  stSheetName = Format(Date, "dd")
  
  'エクセル展開
  'Set xlApp = New Excel.Application
  Set xlApp = CreateObject("Excel.Application")
  Set xlBook = xlApp.Workbooks.Open(stFileName)
  
  'コピー先取得
  For Each xlSheet In xlBook.Worksheets
    If xlSheet.Name = stSheetName Then
      If Len(stSheetName) = 2 Then
        stSheetName = stSheetName & " (2)"
      Else
        stSheetName = Left(stSheetName, 2) & " (" & Val(Mid(stSheetName, 5)) + 1 & ")"
      End If
    End If
    lngCnt = lngCnt + 1
  Next
  
  'シートコピー
  Set xlSheet = xlBook.Worksheets("原紙")
  xlSheet.Copy , xlBook.Worksheets(lngCnt)
  
  'シート名変更
  lngCnt = lngCnt + 1
  Set xlSheet = xlBook.Worksheets(lngCnt)
  xlSheet.Name = stSheetName
  
  'エクセルファイルを閉じる
  xlBook.Close (True)
  xlApp.Quit
  
  'オブジェクトの開放
  Set xlSheet = Nothing
  Set xlBook = Nothing
  Set xlApp = Nothing
  
  '完了メッセージ
  MsgBox "シートをコピーしました"
  
End Sub

作成時は、参照設定で「Microsoft Excel *.* Object Library」にチェックをつけておくと楽ですよ
作成し終わったら、CreateObjectを使って参照設定を元に戻しておけば、バージョン違いのエクセルにも対応できます

Private Sub CmdCopySheet_Click()
  
  'Dim xlApp As Excel.Application
  'Dim xlBook As Excel.Workbook
  'Dim xlSheet As Excel.Worksheet
  Dim xlApp As Object
  Dim xlBook As Object
  Dim xlSheet As Object
  Dim stFileName As String
  Dim stSheetName As String
  Dim lngCnt As Long
  
  'ファイル名指定
  stFileName = "C:\入庫.xls"
  
  'コピーシート名指定
 ...続きを読む

QACCESS VBAでExcelを開き行をコピーしたい

ACCESS VBAでExcelを開き
データを出力しようと思っています。

その時にあらかじめ指定した行をコピーし
その行にデータを出力したいと
思っていますが
行のコピーは、どのようにしたら
できるのですか?

教えてください。
よろしくお願いします。

Aベストアンサー

>あらかじめ指定した行をコピーし
コピーするのはエクセルの特定行ですか。
であればEXCELLのVBAで済む話で、「>ACCESS VBAでExcelを開き
データを出力しようと思っています」は関係ない(影響を受けない)
話です。アクセスもレコードを行と表現することもあると思うので
迷いました。
アクセスからエクセルを開いて、ExcelAplicationの世界に入れば
ブックや、シートなどの上位オブジェクト名をつけて区別が必要になるだけで、エクセルVBAと同じです。エクセルの世界だと、Defaltか効いて、省略している場合が多いだけです。


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング