Access VBA セルの文字位置指定エラー

##使用ソフト・プログラミング言語
使用ソフト：Access
使用言語：VBA

前提・実現したいこと

AccessVBAにて、Accessと同一パス内のExcel【.xlsx】ファイルの書式設定を行おうとしています。

発生している問題・エラーメッセージ

水平文字位置と垂直文字位置の設定でエラーが発生し、文字位置の設定ができません。
※セルにて上下左右の中央に文字を配置したいです。

実行時エラー'1004'Range クラスの VerticalAlignment プロパティを設定できません。
実行時エラー'1004'Range クラスの HorizontalAlignment プロパティを設定できません。

該当のソースコード

'Excelファイルのパスを指定
  Path = C:\Users\ドキュメント\Web
  '※　Excelファイルが使用するAccessファイルと同じフォルダにある場合の表記
  Exf = Dir(Path & "*.xlsx")

  '
  Do
    '実行時バインディング
    Set AppObj = CreateObject("Excel.Application")
    '編集を実施するワークブックを開く
    Set WBObj = AppObj.WorkBooks.Open(Path & Exf)
    '編集を実施するワークシートを設定する
    Set WsObj = WBObj.Worksheets(1)
    'Excelアプリケーションを表示しない
    AppObj.Visible = False
    '繰り返し処理を実行する
    Do
      '繰り返し処理を実行する
      Do
        'ステータスバーの文字列を変更する
        SysCmd acSysCmdSetStatus, j & "列" & i & "行目の書式設定を行っています。"
        '文字列に対して書式設定を行う【省略記述 開始】
        With WsObj.Cells(i, j).Font
          'フォントを変更する
          .Name = "ＭＳ Ｐゴシック"
          '文字サイズを変更する
          .Size = 16
          '文字列を太字にする
          .Bold = True
          '文字色を変更する
          .Color = RGB(0, 0, 0)
        '省略記述 終了
        End With
        '列幅を調整する
        WsObj.Columns(j).AutoFit
        WsObj.Cells(i, j).VerticalAlignment = xlCenter
        WsObj.Cells(i, j).HorizontalAlignment = xlCenter
        '現在の行が偶数行の場合
        If i Mod 2 = 0 Then
          'セルの背景色を変更する
          WsObj.Cells(i, j).Interior.Color = RGB(153, 204, 255)
        '分岐処理を終了する
        End If
        '次の列に移動する
        j = j + 1
      '現在の行にて、空欄のセルになるまで繰り返す
      Loop Until WsObj.Cells(i, j) = ""
      '行カウントを加算する
      i = i + 1: j = 1
    '次の行のＡ列セルが空になるまで繰り返す
    Loop Until WsObj.Cells(i, 1) = ""
    'Excelを保存して閉じる
    WBObj.Save   'ワークブックを保存する
    WBObj.Close 'ワークブックを閉じる
    AppObj.Quit
  MsgBox "『" & Exf & "』の書式設定が完了しました。", vbOKOnly + vbInformation, _
  "Pack-Web 入庫管理システム"
  '次のファイル名を取得する
  Exf = Dir()
  'ファイルがなくなるまで繰り返す
  Loop Until Exf = ""

どのように修正すればよろしいでしょうか？

行動規範の内容に同意します

回答1件

ベストアンサー

WordVBA
1Option Explicit     '変数の宣言を強制する
2Sub test()
3    'Excelファイルのパスを指定
4    Dim Path As String
5'    Path = "C:\Users\ドキュメント\Web\"
6    Path = "\LS420DDB0\share\Desktop\質問箱回答\teratail05セルの文字位置指定\"
7    Dim Exf As String:  Exf = Dir(Path & "*.xlsx")
8    '実行時バインディング
9    Dim AppObj As Object
10    Set AppObj = CreateObject("Excel.Application")
11    Do
12        '編集を実施するワークブックを開く
13        Dim WBObj As Object
14        Set WBObj = AppObj.WorkBooks.Open(Path & Exf)
15        '編集を実施するワークシートを設定する
16        Dim WsObj As Object
17        Set WsObj = WBObj.Worksheets(1)
18        'Excelアプリケーションを表示しない
19        AppObj.Visible = False
20        Dim i As Long: i = 1    '行の初期値
21        Dim j As Long: j = 1    '列の初期値
22        Do  '繰り返し処理を実行する
23            Do  '繰り返し処理を実行する
24                'WordVBA ステータスバーの文字列を変更する
25                Application.StatusBar _
26                        = j & "列" & i & "行目の" _
27                        & "書式設定を行っています。"
28                '文字列に対して書式設定を行う【省略記述 開始】
29                With WsObj.Cells(i, j).Font
30                    'フォントを変更する
31                    .Name = "ＭＳ Ｐゴシック"
32                    .Size = 16          '文字サイズを変更する
33                    .Bold = True        '文字列を太字にする
34                    .Color = RGB(0, 0, 0)   '文字色を変更する
35                End With        '省略記述 終了
36                WsObj.Columns(j).AutoFit    '列幅を調整する
37                Const xlCenter = -4108  'エクセルの定数を宣言
38                WsObj.Cells(i, j).VerticalAlignment = xlCenter
39                WsObj.Cells(i, j).HorizontalAlignment = xlCenter
40                If i Mod 2 = 0 Then     '現在の行が偶数行の場合
41                    'セルの背景色を変更する
42                    WsObj.Cells(i, j).Interior.Color _
43                                        = RGB(153, 204, 255)
44                End If      '分岐処理を終了する
45                j = j + 1   '次の列に移動する
46            '現在の行にて、空欄のセルになるまで繰り返す
47            Loop Until WsObj.Cells(i, j) = ""
48            i = i + 1: j = 1    '行カウントを加算する
49        '次の行のＡ列セルが空になるまで繰り返す
50        Loop Until WsObj.Cells(i, 1) = ""
51        'Excelを保存して閉じる
52        WBObj.Save      'ワークブックを保存する
53        WBObj.Close     'ワークブックを閉じる
54        Set WBObj = Nothing
55        MsgBox "『" & Exf & "』の書式設定が完了しました。" _
56                , vbOKOnly + vbInformation _
57                , "Pack-Web 入庫管理システム"
58        Exf = Dir() '次のファイル名を取得する
59    Loop Until Exf = "" 'ファイルがなくなるまで繰り返す
60    AppObj.Quit
61    Set AppObj = Nothing
62End Sub