我正在嘗試從子例程中定義和呼叫一個函式。當我運行子例程時,我得到“編譯器錯誤:未定義子或函式”。為什么會這樣?
我試圖呼叫的函式在GetImageHeight
下面,但其他任何函式都會發生同樣的情況。
- 我知道這樣的問題經常被問到,原因通常是 OP 做了一些愚蠢的事情。我搜索了類似的問題,但我仍然不明白。
- 下面的功能很大程度上是從這個頁面復制的
這里的代碼:
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
編輯:用代碼替換螢屏截圖。
uj5u.com熱心網友回復:
檢查,您已將 FileExists() 和 IsValidImageFormat() 從源示例復制到您的模塊中。
檢查,您已為專案選擇了 WIA 庫
添加 WIA 2.0 庫:
- 單擊專案選單中的組件(或按 Ctrl-T)。
- 向下滾動并通過在其前面放置復選標記來選擇 Microsoft Windows Image Acquisition Library v2.0。在工具箱中出現的三個新控制元件中。
轉載請註明出處,本文鏈接:https://www.uj5u.com/qianduan/458948.html
下一篇:按標題而不是excel字母搜索列