求大佬帮忙写两个word的VBA宏代码

天云尊者

需求是能一键调整全部图片或选中图片的清晰度、亮度。
https://pan.baidu.com/s/1F7DXfbEsK90IIG1x932wmw
将图上的两个选项，能使用宏命令来一键调节（需要能手动输入清晰度和亮度数值，能有对比度最好，没有也无所谓）。

chuqi26

在word2021版测试后调整了下代码，可以运行
Sub AdjustImageProperties()
    Dim selectedShapes As Word.InlineShapes
    Dim shp As Word.InlineShape
    Dim brightness As Single
    Dim contrast As Single
  
    Dim applyToAll As Boolean
  
    ' 询问用户是否要应用到所有图片
    applyToAll = MsgBox("是否调整所有图片", vbYesNo) = vbYes
  
    ' 用户输入亮度和对比度的值
    brightness = InputBox("亮度调整(范围 0 to 1, 默认0.5不调整):", "亮度", 0.5)
    contrast = InputBox("对比度调整 (范围0 to 1, 默认0.5不调整):", "对比度", 0.5)
     
    ' 检查用户是否选择了文档中的某些图片
   
   
    If Selection.InlineShapes.Count > 0 Then
         
        Set selectedShapes = Selection.InlineShapes
    ElseIf applyToAll Then
        Set selectedShapes = ActiveDocument.InlineShapes
    Else
        MsgBox "请选择至少一张图片进行操作", vbExclamation
        Exit Sub
    End If
  
    ' 应用用户设置的属性
   
    For Each shp In selectedShapes
        ' 对于图片，设置亮度和对比度
        
        shp.PictureFormat.brightness = brightness

        shp.PictureFormat.contrast = contrast
        
      
    Next shp

    MsgBox "调整成功", vbInformation
End Sub

天云尊者

DDDDDDDDDD

chuqi26

Sub AdjustImageProperties()
    Dim selectedShapes As Word.Shapes
    Dim shp As Word.Shape
    Dim brightness As Single
    Dim contrast As Single
    Dim sharpness As Single
    Dim applyToAll As Boolean

    ' 询问用户是否要应用到所有图片
    applyToAll = MsgBox("Do you want to apply settings to all images?", vbYesNo) = vbYes

    ' 用户输入清晰度、亮度和对比度的值
    sharpness = InputBox("Enter sharpness value (范围 -1 to 1, 默认0):", "Image Sharpness", 0)
    brightness = InputBox("Enter brightness value (范围-1 to 1, 默认0.5):", "Image Brightness", 0.5)
    contrast = InputBox("Enter contrast value (范围-1 to 1, 默认0.5):", "Image Contrast", 0.5)

    ' 检查用户是否选择了文档中的某些图片
    If Selection.Type = wdSelectionShape Then
        Set selectedShapes = Selection.ShapeRange
    ElseIf applyToAll Then
        Set selectedShapes = ActiveDocument.Shapes
    Else
        MsgBox "No images selected or found.", vbExclamation
        Exit Sub
    End If

    ' 应用用户设置的属性
    For Each shp In selectedShapes
        If shp.Type = msoPicture Then
            ' 对于图片，设置清晰度、亮度和对比度
            shp.PictureFormat.Brightness = brightness
            shp.PictureFormat.Contrast = contrast
            shp.PictureFormat.Sharpness = sharpness
        End If
    Next shp

    MsgBox "Image adjustments applied successfully!", vbInformation
End Sub

天云尊者

chuqi26 发表于 2024-1-21 08:17
Sub AdjustImageProperties()
    Dim selectedShapes As Word.Shapes
    Dim shp As Word.Shape

直接运行，会提示编译错误，未找到方法和数据成员。word版本是2021，网上找的一闪流溢发布的VBA代码能用。
https://pan.baidu.com/s/1e56SWH9AJLdJ6wo1_3Nzug

天云尊者

chuqi26 发表于 2024-1-21 08:17
Sub AdjustImageProperties()
    Dim selectedShapes As Word.Shapes
    Dim shp As Word.Shape

老哥还在吗？用不了...

chuqi26

修改下，word不能修改图片的清晰度，去掉这个
Sub 宏1()
   
    Dim myTable As Table
   
   
    Dim i As Byte
   
    Dim str As String
   
   
    For i = 1 To 50
   
            
            Set myTable = ActiveDocument.Tables(i)
            
            
            With myTable
            
                .Cell(2, 4).Range.Font.Size = 11
               
                .Cell(21, 3).Range = ""
            
            
            
            End With
   
    Next i


End Sub
Sub 宏2()

Dim x As InlineShape

Dim i As Integer

For Each x In ActiveDocument.InlineShapes
   x.Borders.Enable = True
    x.Borders.OutsideLineWidth = wdLineWidth225pt



Next x




End Sub
Sub s()
Dim x As List

For Each x In ActiveDocument.Lists
    x.ConvertNumbersToText

Next x



End Sub

Sub AdjustImageProperties()
    Dim selectedShapes As Word.Shapes
    Dim shp As Word.Shape
    Dim brightness As Single
    Dim contrast As Single

    Dim applyToAll As Boolean

    ' 询问用户是否要应用到所有图片
    applyToAll = MsgBox("Do you want to apply settings to all images?", vbYesNo) = vbYes

    ' 用户输入清晰度、亮度和对比度的值
    sharpness = InputBox("Enter sharpness value (范围 0 to 1, 默认0):", "Image Sharpness", 0)
    brightness = InputBox("Enter brightness value (范围 to 1, 默认0.5):", "Image Brightness", 0.5)
   
    ' 检查用户是否选择了文档中的某些图片
    If Selection.Type = wdSelectionShape Then
        Set selectedShapes = Selection.ShapeRange
    ElseIf applyToAll Then
        Set selectedShapes = ActiveDocument.Shapes
    Else
        MsgBox "No images selected or found.", vbExclamation
        Exit Sub
    End If

    ' 应用用户设置的属性
    For Each shp In selectedShapes
        If shp.Type = msoPicture Then
            ' 对于图片，设置亮度和对比度
            shp.PictureFormat.brightness = brightness
            shp.PictureFormat.contrast = contrast
         
            
        End If
    Next shp

    MsgBox "Image adjustments applied successfully!", vbInformation
End Sub

chuqi26

刚才还有点问题，这个应该可以了，需要是嵌入文本行的图片
Sub AdjustImageProperties()
    Dim selectedShapes As Word.InlineShapes
    Dim shp As Word.InlineShape
    Dim brightness As Single
    Dim contrast As Single
  
    Dim applyToAll As Boolean
  
    ' 询问用户是否要应用到所有图片
    applyToAll = MsgBox("是否调整所有图片", vbYesNo) = vbYes
  
    ' 用户输入亮度和对比度的值
    brightness = InputBox("亮度调整(范围 0 to 1, 默认0.5):", "Image Sharpness", 0.5)
    contrast = InputBox("对比度调整 (范围0 to 1, 默认0.5):", "Image Brightness", 0.5)
     
    ' 检查用户是否选择了文档中的某些图片
    If Selection.Type = wdSelectionShape And Selection.ShapeRange.Count > 0 Then
        Set selectedShapes = Selection.ShapeRange
    ElseIf applyToAll Then
        Set selectedShapes = ActiveDocument.InlineShapes
    Else
        MsgBox "请选择至少一张图片进行操作", vbExclamation
        Exit Sub
    End If
  
    ' 应用用户设置的属性
    For Each shp In selectedShapes
        ' 对于图片，设置亮度和对比度
        shp.PictureFormat.brightness = brightness
        shp.PictureFormat.contrast = contrast
    Next shp
  
    MsgBox "调整成功", vbInformation
End Sub

virgin_8

chuqi26 发表于 2024-1-23 08:11
刚才还有点问题，这个应该可以了，需要是嵌入文本行的图片
Sub AdjustImageProperties()
    Dim selecte ...

刚才试了试 图片是嵌入的  确实没效果  office2021

天云尊者

chuqi26 发表于 2024-1-14 14:48
在word2021版测试后调整了下代码，可以运行
Sub AdjustImageProperties()
    Dim selectedShapes As Wor ...

这个可用。
清晰度在word的里是能调节的，这个挺重要，单纯调整亮度和对比度容易让图片中的文字模糊。
能不能把调整清晰度的功能加上，单独的一个，不集成在一起也可以。
可行的话，我再追加个悬赏也可以。