なずブログ

インフラSE、Java開発、リモートワークエンジニアな人のメモ帳

AccessからのExcel操作~VBA 入門 Access ~

f:id:nazuna_0124:20190929180554p:plain

Excelを開く枚数が多くてイライラしている皆様こんにちは。

なずなです。


今回はVBAのためだけにAccessを利用するお話です。



完成品

動作風景

f:id:nazuna_0124:20190929180728g:plain


コード


Option Compare Database
Option Explicit




Sub シェイプ全削除()
    Dim sh As Worksheet
    
    Set sh = TageSH("応募書類工程表*")

    Dim shp As Shape
    
    For Each shp In sh.Shapes
        shp.Delete
    Next
    

End Sub


'該当シートを返す
Function TageSH(ByVal bkName As String)
    Dim xls As Excel.Application
    Dim bk As Workbook
    
'Excelを開いていないとエラーのため暫定回避
On Error Resume Next
    Set xls = GetObject(, "Excel.Application")
    Set bk = Nothing
    


    Dim b As Workbook
    
    '引数のブック名を含むブックを検索
    For Each b In xls.Workbooks
        If b.Name Like bkName Then
            Set bk = b
            Exit For
        End If
    Next
    
    Dim sh As Worksheet
    
    If bk Is Nothing Then
        Set sh = Nothing
    Else
        Set sh = bk.Worksheets("工程表")
    End If
    
    
    
    Set TageSH = sh

End Function

'全てのシェイプが削除されるので注意
Sub シェイプの全削除()
    Dim shp As Shape
    Dim sh As Worksheet
    
    Set sh = TageSH("応募書類工程表*")
    
    
    For Each shp In sh.Shapes
        shp.Delete
    Next
    
End Sub

Sub 予定の開始と終了日付の幅でシェイプを配置する()
    Dim sh As Worksheet
    
    Set sh = TageSH("応募書類工程表*")
    
    If sh Is Nothing Then
        MsgBox "応募書類工程表ブックを開いてからボタン押してね"
        Exit Sub
    End If
    
    'A1セルに作成
    '予定シェイプの作成 sh, 1, 1, 50
    
    Dim col As Long
    Dim endCol As Long
    Dim i As Long
    Dim statday
    Dim endday
    
    For i = 5 To 15
        '対象行の開始行を取得
        statday = sh.Cells(i, 8).Value
        endday = sh.Cells(i, 9).Value
        
        Dim x As Long
        
        x = 13
        Do While sh.Cells(3, x).Value <> ""
        
            '試しに表示はしてみましょう
            'Debug.Print sh.Cells(3, x).Value
        
            '日付が一致したら列を代入
            If statday = sh.Cells(3, x) Then
                col = sh.Cells(3, x).Column
            End If
            
            '同日がありえるのでelseifは使わない
            If endday = sh.Cells(3, x) Then
                endCol = sh.Cells(3, x).Column
            End If
        
            x = x + 1
        Loop
        
        '不要になったので削除
        'col = 13 + i - 5
    
        '日付の差計算。0になるので1日足しておく
        '年末年始をまたぐときは年の変え忘れに注意
        Dim 日付差
        日付差 = DateDiff("d", statday, endday) + 1
        
        '
        Debug.Print 日付差
        
        '日付の幅は固定だとしてM列(13)を利用
        予定シェイプの作成 sh, i, col, sh.Cells(i, 13).Width * 日付差
    Next
    
    
End Sub

Sub 予定シェイプの作成(ByVal sh As Worksheet, ByVal top, ByVal left, ByVal w)
    Dim shp As Shape
    
    Set shp = sh.Shapes.AddShape(1, sh.Cells(top, left).left, sh.Cells(top, left).top, 15, 15)
    
    '高さ
     shp.Height = 10
     
    '幅
     shp.Width = w
    
End Sub


Accessを使いたくなる理由

1. Excelを開く枚数が多い

Excelで管理をしていたりすると5枚くらい開くことが多いです。

管理用、参照用、これから編集する用、作業手順、報告用みたいに。


ここからさらにVBAのツール用と開きたいないので、あえてAccessにのせます。


2. 共有ブックが使いにくい

データの重複、同時更新がしにくい場合や、ブックが壊れてしまったときに

検討されることが多いです。

わたしもいろいろ試しましたが、Accessも同じ問題を抱えてます。

この理由で使うのは非推奨。


3. SQLを気軽に使いたい

慣れているとExcelのピポッドより使いやすかったりします。

これから勉強したいという方にはおすすめです。


みどころ

1. GetObjectの使い方

OutlookやWordを使う場合でも似たケースになります。

Office製品同士の連携はVBAの特徴の一つなので覚えておきましょう。


2. ブックの検索

VBAにはブックの存在確認の関数はメソッドはありません。

自作になります。ExcelVBAとしてもよく使用します。


このときLike演算子を使っておくとブック名が月単位で変わる場合などにも

対応できます。



とゆーわけで以上です。

何か質問ありましたらお気軽にどうぞです。