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

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

AMP変換ソフト作成 メニューへ

スポンサーリンク





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

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

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

※ こでは変換ファイル名と同じフォルダか、サブフォルダ内に画像ファイルがあることとしています。
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です。
VBAで画像のサイズを取得しWidthとHeightを追加する

・初めに変換ファイル名のフォルダを取得しています。
・画像ファイルの<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

スポンサーリンク






AMP変換ソフト作成 メニューへ

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します


Copyright (c) Excel-Excel ! All rights reserved