PowerPoint 2010 VBA克隆纹理填充时PresetTexture返回-2问题求助

我之前也踩过PPT对象模型的这个坑！当使用msoTextureGranite这类内置纹理填充时，直接读取Shape.Fill.PresetTexture确实会返回msoPresetTextureMixed，这是因为PPT对部分内置纹理的属性暴露存在小问题，导致我们没法直接通过这个属性判断纹理类型，进而引发后续代码崩溃。

下面给你两种可靠的解决方案，能完美覆盖你的需求：

方案一：直接克隆Fill对象的所有属性（推荐） #

不用单独判断填充类型，直接把源形状的Fill设置完整复制到目标形状，不管是纯色、渐变还是内置纹理都能精准克隆，代码还更简洁：

Sub CloneFillOnly(sourceSh As Shape, targetSh As Shape)
    ' 先清除目标形状的现有填充，避免残留设置干扰
    targetSh.Fill.Solid
    ' 直接复制源填充的所有属性到目标形状
    sourceSh.Fill.Copy
    targetSh.Fill.Paste
End Sub

这个方法利用Fill.Copy和Fill.Paste，相当于把源填充的所有配置完整“搬”过去，完全避开了PresetTexture的坑，支持所有填充类型，包括你提到的内置纹理场景。

方案二：通过TextureName属性判断内置纹理（适合差异化处理） #

如果你需要对不同填充类型做单独逻辑处理，可以读取Shape.Fill.TextureName属性——内置纹理的这个属性会返回对应的名称（比如花岗岩纹理会返回"Granite"），我们可以根据名称映射到对应的PresetTexture常量：

Sub CloneTextureFill(sourceSh As Shape, targetSh As Shape)
    With sourceSh.Fill
        If .Type = msoFillTextured Then
            ' 区分内置纹理和自定义纹理
            If .TextureType = msoTexturePreset Then
                Dim presetTex As MsoPresetTexture
                ' 根据TextureName映射到对应的内置纹理常量
                Select Case .TextureName
                    Case "Granite"
                        presetTex = msoTextureGranite
                    Case "Marble"
                        presetTex = msoTextureMarble
                    Case "White Marble"
                        presetTex = msoTextureWhiteMarble
                    ' 可以继续添加你需要用到的其他内置纹理映射
                    Case Else
                        presetTex = msoTextureWhiteMarble ' 兜底处理未知纹理
                End Select
                ' 将纹理应用到目标形状
                targetSh.Fill.PresetTextured presetTex
            Else
                ' 处理自定义纹理的情况
                targetSh.Fill.UserTextured .TextureName
            End If
        Else
            ' 这里保留你原来处理纯色、渐变等填充类型的代码
        End If
    End With
End Sub

这个方法适合需要对不同填充类型做差异化逻辑的场景，不过需要手动维护TextureName和MsoPresetTexture常量的映射表，因为PPT没有提供直接的转换方法。

补充说明 #

为什么PresetTexture会返回msoPresetTextureMixed？这是PPT对象模型的一个已知小问题，部分内置纹理在存储时没有正确关联对应的枚举值，导致读取时返回混合状态。所以尽量避免依赖这个属性判断内置纹理类型，优先用Fill.Copy/Paste或者TextureName来处理。

内容的提问来源于stack exchange，提问作者karldegen