Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


61 / 500 ページ ←次へ | 前へ→

【12092】Re:EXCELへの出力・編集
質問  AKG  - 11/10/5(水) 22:37 -

引用なし
パスワード
   ▼よろずや さん
またお時間空いてしまって申し訳ありません。

>提示したページはオートメーションのほんの一例です。
>オートメーションを使うとエクセルのすべての機能を使用できます。
>
>(1)新しいブックを作る。
>(2)テーブルデータをシートに貼り付ける。
>(3)罫線等を付ける。
>(4)新しいシートを追加する。
>(5)テーブルデータをシートに貼り付ける。
>(6)罫線等を付ける。
>(7)新しいシートを追加する。
>(8)テーブルデータをシートに貼り付ける。
>(9)罫線等を付ける。
>(10)ブックを保存する。
>すべてできます。
>
>createobject excel.application
>で検索してみてください。

教えていただいたページを参考に少しがんばってみました。

Attribute VB_Name = "Module1"
Option Compare Database
Sub 出力編集()
 
 Dim xlApp As Excel.Application
 Dim xlBook As Excel.Workbook
 Dim xlSheet As Excel.Worksheet
 Dim strFilename As String
 Dim strSheetName As String
                                
  strFilename = "C:\ファイル.xls"
 
  strSheetName = "シート1"

 Set xlApp = CreateObject("Excel.Application")
 
  xlApp.Workbooks.Open Filename:=strFilename, UpdateLinks:=0
 
  xlApp.Visible = True

 Set xlBook = xlApp.Workbooks(Dir(strFilename))

 Set xlSheet = xlBook.Worksheets(strSheetName)
 
 ’xlSheet.Cells(1, 1).Value = "HELLO"

 
xlSheets("strSheetName").Select

  Range("A1:K41").Select
  Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  
  With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlInsideVertical)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlInsideHorizontal)
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
  End With
  
  Range("A1:K1").Select
  Selection.Font.Bold = True
  With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
  End With

strSheetName = "シート2"

xlSheets("strSheetName").Select

Range("A1:AG71").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

  With Selection.Borders(xlEdgeLeft)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeTop)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeBottom)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeRight)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlInsideVertical)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlInsideHorizontal)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With

strSheetName = "シート3"

xlSheets("strSheetName").Select

Range("A1:AG14").Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone

  With Selection.Borders(xlEdgeLeft)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeTop)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeBottom)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlEdgeRight)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlInsideVertical)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With
  
  With Selection.Borders(xlInsideHorizontal)
  .LineStyle = xlContinuous
  .Weight = xlThin
  .ColorIndex = xlAutomatic
  End With

' xlApp.Run ("Macro4")
xlBook.Close saveChanges:=True
xlApp.Quit

 Set xlSheet = Nothing
 Set xlBook = Nothing
 Set xlApp = Nothing

End Sub

このようなカンジにつくってみたのですが、「SubまたはFunctionがありません」というエラーがでてしまいます。

1番上のこの行でした
xlSheets("strSheetName").Select


1度EXCELにマクロを作って、そちらを起動させようかとも考えたのですが・・・
できればACCESS内で完結させたいのでアドバイスいただけるとありがたいです。

よろしくお願いいたします。
・ツリー全体表示

【12091】2つのテーブルの照合
質問  sora  - 11/9/30(金) 0:24 -

引用なし
パスワード
   いつも、参考にさせていただいてます。
さっそくですが、ご指導いただきたく、投稿しました。

2つのテーブル
T_BBB
T_CCC

この2つのテーブルのフィールド名は、全く同じですが
フィールドの数が、110程あります。

2つのテーブルの中身データの照合をし

一致したデータと、T_BBBのみしかないデータ、T_CCCしかないデータの
各テーブルを作成したく

下記の様なのを作ってはみたものの、、、

Dim TB_BBB As DAO.Recordset 'レコードセットの変数
Dim TB_CCC As DAO.Recordset

Set TB_BBB = DB.OpenRecordset("Select * from BBB;") 'テーブルBBB全て

While TB_BBB.EOF = False

strSQL = "SELECT CCC.* FROM CCC "
strSQL = strSQL & "WHERE (((CCC.品番)='" & TB_BBB![品番] & "') "
strSQL = strSQL & " AND ((CCC.ロット)='" & TB_BBB![ロット] & "') "




strSQL = strSQL & " AND ((CCC.数量)='" & TB_BBB![数量] & "'));"

こんな感じで、110件ほど書きましたが条件が多すぎるのか、【クエリが複雑】と、なってしまいできません


件数が大量の場合の処理の仕方教えてください
宜しくお願い致します
・ツリー全体表示

【12090】Re:EXCELへの出力・編集
回答  よろずや  - 11/9/29(木) 0:19 -

引用なし
パスワード
   ▼AKG さん:
>お答えいただいたのに、時間が空いてしまってもうしわけありません。
>
>>こちらが参考になるでしょうか。
>>
>>h tp://www.accessclub.jp/samplefile/samplefile_204.htm
>
>何度も読み返してみたのですが、内容としては出力とEXCELの基点のセル位置へ
>テーブルを転記するものだと解釈いたしました。
>
>このやり方だと事前にEXCELのシートは準備しておいて、貼り付けるといった感じでしょうか。

提示したページはオートメーションのほんの一例です。
オートメーションを使うとエクセルのすべての機能を使用できます。

(1)新しいブックを作る。
(2)テーブルデータをシートに貼り付ける。
(3)罫線等を付ける。
(4)新しいシートを追加する。
(5)テーブルデータをシートに貼り付ける。
(6)罫線等を付ける。
(7)新しいシートを追加する。
(8)テーブルデータをシートに貼り付ける。
(9)罫線等を付ける。
(10)ブックを保存する。
すべてできます。

createobject excel.application
で検索してみてください。
・ツリー全体表示

【12089】Re:EXCELへの出力・編集
質問  AKG  - 11/9/28(水) 14:39 -

引用なし
パスワード
   お答えいただいたのに、時間が空いてしまってもうしわけありません。

>こちらが参考になるでしょうか。
>
>h tp://www.accessclub.jp/samplefile/samplefile_204.htm

何度も読み返してみたのですが、内容としては出力とEXCELの基点のセル位置へ
テーブルを転記するものだと解釈いたしました。

このやり方だと事前にEXCELのシートは準備しておいて、貼り付けるといった感じでしょうか。

それだと、少しやりたいこととちがうかと思います。

EXCEL出力まではできています。
問題はこの出来上がったファイルのシートに罫線等の編集を自動で行い、表の見栄えをよくしてあげたいのです。

大雑把な質問をしてすみません。
お答えいただけたら幸いです、よろしくお願いいたします。
・ツリー全体表示

【12088】Re:VBAでJPGファイルのリサイズをして別...
お礼  TXT  - 11/9/26(月) 16:31 -

引用なし
パスワード
   ちん さんありがとうございます。
感謝。
・ツリー全体表示

【12087】Re:VBAでJPGファイルのリサイズをして別...
発言  ちん  - 11/9/26(月) 14:50 -

引用なし
パスワード
   こんにちわ、TXT さん:
 ちんと申します。

>JPG画像をVBAでリサイズして別名で保存したいのですが
>どの様にすればいいのかさっぱりわからず困っております。
>どなたかご教授お願いします。

使用したことないですが、
明熊JPG保存DLL をダウンロードし、
リサイズ後、保存したり、クリップボードの画像を名前付けて保存
したりできるようです。
VBまたは、VBAで使用できます。

以上、参考までに・・・
・ツリー全体表示

【12086】Re:データの統合
発言  nonon  - 11/9/22(木) 14:40 -

引用なし
パスワード
   あぁ・・・これ私の勘違いかも。。。


えっと、
>Aテーブルのフィールドを店名、商品1、商品2・・商品100にし
>Bテーブルのフィールドを店名、商品1、商品2・・商品999にしたい場合
の意味ってどういう事でしょうか。

現時点では、Aテーブルには店名と商品という項目があると思いますが、
Aテーブルの項目はそうではなく、「店名、商品1、商品2・・商品100」
となっているという事でしょうか。

スクリプト拝見させて頂いたところ、一応はAテーブルからBテーブルを
作成できているとは思いますが、MAXで商品999を想定した場合、
どのように組みなおせば良いかという事でしょうか。

上記の場合、例えば、Bテーブルをスクリプト上で動的に作成する方法
などがあると思います。

Aテーブルの店名毎にカウントをとってそのMAXが「商品xxx」にあたい
しますので、そこでその情報を基にBテーブルのCreateを行い、Insert
していけば良いかと思います。

解釈、、、合っていますでしょうか。
・ツリー全体表示

【12085】Re:データの統合
発言  nonon  - 11/9/22(木) 14:17 -

引用なし
パスワード
   ▼snbtkmt さん:

返信が遅くなってしまいすみませんでした。
そして、私が書いた構文に間違いがありました・・・すみません。

case文は使用できなく、クエリではSwitch文の使用でした。

または、クロス集計など如何でしょうか。
例えば、Aテーブルに商品コードのような項目を用意し、
以下のSQLでクロス集計を作成。
(AテーブルをExcelに落とし、フィルタなどをかけ商品コード付与)

■Aテーブル
店名 商品名 商品コード
A店  リンゴ 1
A店  トマト 2
A店  ナシ  3
B店  リンゴ 1
B店  みかん 4

■SQL
TRANSFORM Max(商品.[商品名]) AS 商品名の最大
SELECT 商品.[店名]
FROM 商品
GROUP BY 商品.[店名]
PIVOT 商品.[商品コード]
        ↑
商品コードを追加しなくて、ココを商品名でもOKですが、列名が・・・。

■追伸
「縦持ち 横持ち」などで検索すると色々と参考情報を
得る事ができますので、一度確認してみてください。

また、大した回答ができずすみません。
最初に投稿のあったスクリプトも拝見しておきますね。
・ツリー全体表示

【12084】Re:IBM特殊文字を調査
お礼  ケミー  - 11/9/19(月) 23:56 -

引用なし
パスワード
   ▼よろずや さん:
>マルチポストされた別サイトに回答しました。
>
>マルチポストについては、こちらをご覧ください。
>h tp://www.vbalab.net/bbspolicy.html

ありがとうございます。
大変参考になりました。
・ツリー全体表示

【12083】Re:IBM特殊文字を調査
発言  よろずや  - 11/9/19(月) 23:11 -

引用なし
パスワード
   マルチポストされた別サイトに回答しました。

マルチポストについては、こちらをご覧ください。
h tp://www.vbalab.net/bbspolicy.html
・ツリー全体表示

【12082】IBM特殊文字を調査
質問  ケミー  - 11/9/19(月) 12:23 -

引用なし
パスワード
   教えてください。

顧客テーブルがあり、内容はキー番号(半角10バイト)、漢字氏名(全角50バイト)、カナ氏名(半角50バイト)です。
漢字氏名フィールドを調査して特殊文字コードが存在した場合エラーメッセージを表示したいので、以下の様なロジックを作成したのですが、すべての漢字氏名がエラーとなってしまいます。なぜでしょうか?
教えていただけますでしょうか。お願いいたします。

Public Sub 調査()
  Dim DB As DAO.Database
  Dim RS As DAO.Recordset
  Dim Moji As String

  Set DB = CurrentDb()
  Set RS = DB.OpenRecordset("顧客テーブル", dbOpenDynaset)

Do Until RS.EOF
  If RS!漢字氏名 Like "*[" & Chr("&hFA40") & "-" & Chr("&hFC4B") & "]*"
  Then
   Msgbox RS!漢字氏名
  End If
  RS.MoveNext
Loop
  RS.Close: Set RS = Nothing
  DB.Close: Set DB = Nothing
End Sub
・ツリー全体表示

【12081】Re:データの統合
発言  snbtkmt  - 11/9/17(土) 1:09 -

引用なし
パスワード
   はじめまして、nonon様
ご投稿いただき、ありがとうございます。
ご親切な内容で大変感謝しております。

この'メラ'や'ギラ'に入るのはリンゴやトマトになるのでしょうか?
それとも、A店やB店になるのでしょうか?
こちらの知識不足で申し訳ございませんが、教えていただけますと幸いです。
またどちらに装飾するにしても、エラーになってしまいました。
エラー内容は下記のとおりです。

「クエリ式' MAX(CASE 商品 WHEN 'メラ'THEN 商品 ELSE NULL END)'の構文エラー:演算子がありません。」

今一度お知恵を拝借させていただきたく投稿させていただきました。
何卒宜しくお願い申し上げます。
・ツリー全体表示

【12080】Re:テーブルの日付によってフォームの操作
お礼  バッセン  - 11/9/16(金) 20:57 -

引用なし
パスワード
   nononさん。
ありがとうございました。
・ツリー全体表示

【12079】テーブルの日付によってフォームの操作
お礼  バッセン  - 11/9/16(金) 7:50 -

引用なし
パスワード
   ありがとうございました
・ツリー全体表示

【12078】Re:データの統合
発言  nonon  - 11/9/15(木) 15:26 -

引用なし
パスワード
   ▼snbtkmt さん:

はじめまして、nononです。

レスがつきませんね。。。

ご質問内容は、AテーブルをBテーブルみたくできれば良いということですか?
そうであれば、アドバイスになるか分かりませんが、以下SQLでもできるので一応投稿します。
以下を基に装飾してみてください。

ちなみに、MAX行をLOOPにし、商品あるだけ回せば100も999もいけるはず。。。
ただ、レスポンスはどうかわからないです。。。

SELECT
  店名, 
  MAX( CASE 商品 WHEN 'メラ' THEN 商品 ELSE NULL END ) AS 商品1 ,
  MAX( CASE 商品 WHEN 'ギラ' THEN 商品 ELSE NULL END ) AS 商品2 ,
  MAX( CASE 商品 WHEN 'イオ' THEN 商品 ELSE NULL END ) AS 商品3
FROM
  Aテーブル
GROUP BY
  店名
・ツリー全体表示

【12077】Re:テーブルの日付によってフォームの操作
回答  nonon  - 11/9/15(木) 14:59 -

引用なし
パスワード
   ▼バッセン さん:

はじめまして、nononです。

簡単なサンプルとなりますので、色々と装飾してください。
また、検索すればすぐ解決できると思いますので、
以下ソースで分からない部分があれば検索してみてください。

■以下ソースの前提
Aテーブルには日付が格納された1レコードのみ存在

■BフォームのForm_Loadに記載

Private Sub Form_Load()

  Dim DB As Database
  Dim RS As Recordset

  Set DB = CurrentDb()
  Set RS = DB.OpenRecordset("A", dbOpenTable)
  
  If RS!日付 < "2004/01/01" Then
    MsgBox "2004/01/01以前なので画面を閉じます。"
    DoCmd.Close acForm, "B"
  Else
    MsgBox "2004/01/01以降なので画面を開きます。"
  End If
    
End Sub
・ツリー全体表示

【12076】テーブルの日付によってフォームの操作
質問  バッセン  - 11/9/15(木) 10:08 -

引用なし
パスワード
   Aと言うテープルとBと言うフォームがあります。
テーブルはフィールド名が「日付」でデータ型が「日付/時計型」です。
テーブルには日付が1項目だけ入ってます。(例 2004/01/01」)
Bフォームの開くイベントに設定したいのです。
Bフォームが開く時にAテーブルの日付を参照してフォームを操作したいのです。
例、Aテーブルの日付(2004/01/01)で2003/12/31まではBフォームを開いても通常通り開いて、2004-01/01以降、開こうとしたらBフォームを開かず、そのまま閉じるようにしたいのです。
アクセス2003を使用してます。
・ツリー全体表示

【12075】VBAでJPGファイルのリサイズをして別名で...
質問  TXT  - 11/9/7(水) 15:52 -

引用なし
パスワード
   JPG画像をVBAでリサイズして別名で保存したいのですが
どの様にすればいいのかさっぱりわからず困っております。
どなたかご教授お願いします。
・ツリー全体表示

【12074】データの統合
質問  snbtkmt  - 11/9/6(火) 22:20 -

引用なし
パスワード
   AテーブルをBテーブルのように店名で統合する記述が下記にありますが
Aテーブルのフィールドを店名、商品1、商品2・・商品100にし
Bテーブルのフィールドを店名、商品1、商品2・・商品999にしたい場合
どこをどのように直せばいいか教えていただけますでしょうか?
宜しくお願いいたします。

Aテーブル
 店名  | 商品 |
 A店  |リンゴ |
 A店  |トマト |
 A店  |ナシ  |
 B店  |リンゴ |
 B店  |みかん |

Bテーブル

店名  |商品1 |商品2 |商品3 |商品4 |
A店  |リンゴ |トマト |ナシ  |   |
B店  |リンゴ |みかん |    |   |

--------------------------------------------------------------------
Function TEST02()
  
  Dim Rec01 As DAO.Recordset
  Dim Sql_Str As String
  Dim ShopName As String
  Dim Shouhin(4) As String
  Dim F_Number As Integer
  Dim i As Integer
  Dim Insert_Str As String
  
  'DoCmd.RunSQL で確認メッセージが出ないようにする
  DoCmd.SetWarnings False
  
  '現在のBテーブルのデータをすべて削除する
  DoCmd.RunSQL "DELETE * FROM Bテーブル;"
  
  Sql_Str = "SELECT * FROM Aテーブル ORDER BY 店名, 商品;"
  Set Rec01 = CurrentDb.OpenRecordset(Sql_Str, dbOpenForwardOnly)
  
  'フィールドの数の上限を入れておく
  F_Number_Max = 4
  
  'ShopName にとりあえずありえないデータを入れておく
  ShopName = "XXX"
  F_Number = 1
  
  For i = 1 To F_Number_Max
    Shouhin(i) = ""
  Next i
  
  Do Until Rec01.EOF
    '最初のレコードではない または 店名が変わったら
    If ShopName <> "XXX" And ShopName <> Rec01!店名 Then
      'INSERT文を作る
      Insert_Str = ""
      
      For i = 1 To F_Number_Max
        If Shouhin(i) <> "" Then
          Insert_Str = Insert_Str & ", '" & Shouhin(i) & "'"
        Else
          Insert_Str = Insert_Str & ", Null"
        End If
      Next i
      
      'Bテーブルにデータを追加
      DoCmd.RunSQL "INSERT INTO Bテーブル" & _
        "(店名, 商品1, 商品2, 商品3, 商品4) " & _
        "VALUES('" & ShopName & "'" & Insert_Str & ");"
      
      F_Number = 1
      
      For i = 1 To F_Number_Max
        Shouhin(i) = ""
      Next i
      
    End If
    
    ShopName = Rec01!店名
    
    '万が一上限の数を超えてしまったら Shouhin への代入は行わない
    If F_Number <= F_Number_Max Then
      Shouhin(F_Number) = Rec01!商品
      F_Number = F_Number + 1
    End If
    
    Rec01.MoveNext
  Loop
  
  Rec01.Close
  
  '最初のレコードではない(最後の店名の分を処理する)
  If ShopName <> "XXX" Then
    'INSERT文を作る
    Insert_Str = ""
    
    For i = 1 To F_Number_Max
      If Shouhin(i) <> "" Then
        Insert_Str = Insert_Str & ", '" & Shouhin(i) & "'"
      Else
        Insert_Str = Insert_Str & ", Null"
      End If
    Next i
    
    'Bテーブルにデータを追加
    DoCmd.RunSQL "INSERT INTO Bテーブル" & _
      "(店名, 商品1, 商品2, 商品3, 商品4) " & _
      "VALUES('" & ShopName & "'" & Insert_Str & ");"
    
    F_Number = 1
    
    For i = 1 To F_Number_Max
      Shouhin(i) = ""
    Next i
    
  End If
  
  '確認メッセージが出るようにする
  DoCmd.SetWarnings True
  
End Function
・ツリー全体表示

【12073】Re:列非固定のクロス集計クエリのレポー...
お礼  まき  - 11/9/6(火) 14:30 -

引用なし
パスワード
   お騒がせしました。自己解決しました。
今度からもっとよく考えてから投稿します。
・ツリー全体表示

61 / 500 ページ ←次へ | 前へ→
ページ:  ┃  記事番号:
1078325
(SS)C-BOARD v3.8 is Free