Step17：AMP対応のため画像サイズを取得しWidthとHeightを追加する｜Excel VBA

このサイトの画像は、モバイルフレンドリーに対応させるため100％のサイズにしていて、WidthとHeightを使用していません。AMP対応のためには画像サイズを指定する必要があるので、取得し<amp-imgに追加します。

VBAでフルパスからフォルダを取得する

画像サイズを取得するためには、画像ファイルのフルパスが必要になります。
そこで変換ファイル名からフルパス名を取り出します。

フルパスから親パスを取得を参照してください。

※ こでは変換ファイル名と同じフォルダか、サブフォルダ内に画像ファイルがあることとしています。


Public Function ExGetParentPath(sPath As String) As String
     Dim str As String
     Dim n1 As Integer
     Dim n2 As Integer
     
     n2 = 0
     Do
         n2 = n2 + 1
         n1 = InStr(n2, sPath, "\")
         If n1 <> 0 Then n2 = n1
     Loop While n1 <> 0
     ExGetParentPath = Left(sPath, n2 - 1)
 End Function

VBAで画像のサイズを取得しWidthとHeightを追加する

取得方法は、Excel VBAでJPG・GIF・PNGの画像ファイルから画像サイズを取得してみるを参照してください。

画像ファイルを検索し、見つかれば幅と高さを取得し<am-imgを作成するVBAです。


・初めに変換ファイル名のフォルダを取得しています。
・画像ファイルの<img srcタグを検索します。
・画像ファイル名を取り出します。
・画像ファイルを開き、幅と高さを取得します。
・<amp-imgタグを作成します。0.0378でピクセルに変換しています。
・実行結果はイミディエイトウィンドウで確認してください。

Private Sub MyPicChange()
    Dim n0 As Long
    Dim n1 As Long
    Dim n2 As Long
    Dim s1 As String
    Dim s2 As String
    Dim sPass As String
    Dim img As Object
    Dim stag As String

    sPass = ExGetParentPath(Range("変換ファイル名"))
    n0 = 1
    Do
        n1 = InStr(n0, sUtfBuf, "<img src=", vbTextCompare)
        If n1 > 0 Then
            n2 = InStr(n1 + 5, sUtfBuf, ">", vbTextCompare)
            s1 = Mid(sUtfBuf, n1, n2 - n1 + 1)
            s2 = MyPicChangeSub(s1)
            Set img = LoadPicture(sPass & s2)
            stag = "<amp-img src=""" & s2 & """ width=""" & Int(img.Width * 0.0378) _
                & """ height=""" & Int(img.Height * 0.0378) & """"
            Debug.Print stag
            n0 = n2
        Else
            Exit Sub
        End If
    Loop
End Sub