I am trying to define and call a function from a subroutine. When I run the subroutine, I get "Compiler error: Sub or function not defined". Why is this happening?
The function I am trying to call is th GetImageHeight
below, but the same happens with any of the other functions.
- I understand that such questions get asked frequently, and the cause is usually the OP doing something stupid. I searched for similar questions, but I still don't get it.
- The function below is largely copied from this page
Here the code:
Function FileExists(FilePath As String) As Boolean
On Error Resume Next
If Len(FilePath) > 0 Then
If Not Dir(FilePath, vbDirectory) = vbNullString Then FileExists = True
End If
On Error GoTo 0
End Function
Function IsValidImageFormat(FilePath As String) As Boolean
Dim imageFormats As Variant
Dim i As Integer
imageFormats = Array(".bmp", ".jpg", ".gif", ".tif", ".png")
For i = LBound(imageFormats) To UBound(imageFormats)
If InStr(1, UCase(FilePath), UCase(imageFormats(i)), vbTextCompare) > 0 Then
IsValidImageFormat = True
Exit Function
End If
Next I
End Function
Sub DeleteImages()
Dim ThisImage As InlineShape
Dim Height As Double
Dim Width As Double
Dim TotalCount As Integer
Dim Count As Integer
Dim Source As String
Dim ImageHeightPx As Double
Dim ImageWidthPx As Double
Dim ImagePath As String
Dim ImageName As String
Dim FileName As String
ImagePath = "C:\Users\User\Image\"
FileName = Mid(ActiveDocument.Name, 1, InStr(1, ActiveDocument.Name, ".") - 1)
Set myStyle = ActiveDocument.Styles.Add(Name:="Replaced Image", Type:=wdStyleTypeCharacter)
TotalCount = ActiveDocument.InlineShapes.Count
ImageCount = 1
For Each ThisImage In ActiveDocument.InlineShapes
ImageName = FileName & "_IMG_" & Trim(Str(ImageCount))
MsgBox ImageName
ThisImage.Select
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Style = "Replaced Image"
Selection.TypeText Text:="[[[ " & ImageName & " ]]]"
ImageHeightPx = GetImageHeight(ImagePath & ImageName & ".png")
ImageWidthPx = GetImageWidth(ImagePath & ImageName & ".png")
MsgBox "Height: " & Str(ImageHeightPx)
MsgBox "Width: " & Str(ImageWidthPx)
ImageCount = ImageCount 1
Next ThisImage
End Sub
Function GetImageHeight(ImagePath As String) As Variant
Dim imgHeight As Integer
Dim wia As Object
If FileExists(ImagePath) = False Then Exit Function
If IsValidImageFormat(ImagePath) = False Then Exit Function
On Error Resume Next
Set wia = CreateObject("WIA.ImageFile")
If wia Is Nothing Then Exit Function
On Error GoTo 0
wia.LoadFile ImagePath
imgHeight = wia.Height
Set wia = Nothing
GetImageHeight = imgHeight
End Function
Function GetImageWidth(ImagePath As String) As Variant
Dim imgWidth As Integer
Dim wia As Object
If FileExists(ImagePath) = False Then Exit Function
If IsValidImageFormat(ImagePath) = False Then Exit Function
On Error Resume Next
Set wia = CreateObject("WIA.ImageFile")
If wia Is Nothing Then Exit Function
On Error GoTo 0
wia.LoadFile ImagePath
imgWidth = wia.Width
Set wia = Nothing
GetImageWidth = imgWidth
End Function
Edits: replaced screenshot with code.
CodePudding user response:
check, you have copied FileExists() and IsValidImageFormat() from source sample into your module.
check, you have selected WIA library for the project
To add WIA 2.0 library:
- Click Components from the Project menu (or press Ctrl-T).
- Scroll down and select Microsoft Windows Image Acquisition Library v2.0 by placing a checkmark in front of it. Of the three new controls that appear on in the Toolbox.