1234

ExcelHome技术论坛

用户名  找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

帖子
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 432|回复: 10

[求助] PPT中如何将一张图片颜色反相(vba)

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-12-22 16:11 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 woxoo 于 2024-12-22 18:35 编辑

如题,
这是OK插件开源的C#代码,哪位高手能转换为vba吗:


public void button105_Click(object sender, RibbonControlEventArgs e)
{
    PowerPoint.Selection sel = app.ActiveWindow.Selection;
    PowerPoint.Slide slide = app.ActiveWindow.View.Slide;
    string apath = app.ActivePresentation.Path;
    if (sel.Type == PowerPoint.PpSelectionType.ppSelectionNone)
    {
        MessageBox.Show("请先选中一张图片");
    }
    else
    {
        PowerPoint.ShapeRange range = sel.ShapeRange;
        int count = range.Count;
        for (int p = 1; p <= count; p++)
        {
            PowerPoint.Shape pic = range[p];
            pic.Copy();
            PowerPoint.Shape npic = slide.Shapes.PasteSpecial(PowerPoint.PpPasteDataType.ppPastePNG)[1];
            pic.ScaleHeight(1f, Office.MsoTriState.msoFalse, Office.MsoScaleFrom.msoScaleFromMiddle);
            pic.Export(apath + @"xshape.png", PowerPoint.PpShapeFormat.ppShapeFormatPNG);
            Bitmap bmp0 = new Bitmap(apath + @"xshape.png");

            for (int i = 0; i < bmp0.Width; i++)
            {
                for (int j = 0; j < bmp0.Height; j++)
                {
                    Color color = bmp0.GetPixel(i, j);
                    int nr = 0, ng = 0, nb = 0;
                    int na = color.A;
                    if (na != 0)
                    {
                        nr = 255 - color.R;
                        ng = 255 - color.G;
                        nb = 255 - color.B;
                        bmp0.SetPixel(i, j, Color.FromArgb(na, nr, ng, nb));
                    }
                }
            }
            bmp0.Save(apath + @"xshape2.png");
            PowerPoint.Shape pic2 = slide.Shapes.AddPicture(apath + @"xshape2.png", Office.MsoTriState.msoFalse, Office.MsoTriState.msoTrue, pic.Left, pic.Top + pic.Height / 2 - npic.Height / 2, npic.Width, npic.Height);
            npic.Delete();
            bmp0.Dispose();
            File.Delete(apath + @"xshape.png");
            File.Delete(apath + @"xshape2.png");
            pic.Delete();
            pic2.Select();
        }
    }

}

TA的精华主题

TA的得分主题

发表于 2024-12-23 13:53 | 显示全部楼层
其实这不是转不转的问题,这是没有可转化性的,在VBA里面创建一个可以编辑的位图对象还是不容易的。VBA本身没有,得使用API函数。

我倒是简单写了一个,但是执行对象只能是位图,需要在VBA里面引用Microsoft Windows Image Acquisition Library v2.0
而且这个程序效率不高,能读取一个位图,反色,另存为一个位图。下面代码的路径你需要自己处理,另外如果你希望读取更多格式,可能会更麻烦,位图是不压缩的,读取顺序就好了,其他格式则涉及到编码器压缩解压缩数据的问题,更复杂。所以最好取搜个现成的引用库来用就好了。。。
代码如下:(自己用画图画一个,然后另存为BMP格式,就可以实验了)
  1. Private Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
  2. Private Declare PtrSafe Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  3. Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  4. Private Declare PtrSafe Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  5. Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  6. Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  7. Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  8. Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  9. Const LOGPIXELSX As Long = 88
  10. Const LOGPIXELSY As Long = 90

  11. Sub test()

  12.     Dim hScreenDC As Long
  13.     hScreenDC = GetDC(0)
  14.     Dim xDPI As Long, yDPI As Long
  15.     xDPI = GetDeviceCaps(hScreenDC, LOGPIXELSX)
  16.     yDPI = GetDeviceCaps(hScreenDC, LOGPIXELSY)
  17.     ReleaseDC 0, hScreenDC

  18.     Dim pic As StdPicture
  19.     Set pic = LoadPicture("yourpath\1.bmp")
  20.     Dim hdc As Long, hMemDC As Long, oldObj As Long
  21.     hMemDC = CreateCompatibleDC(0)
  22.     oldObj = SelectObject(hMemDC, pic.Handle)
  23.     Dim r As Long, g As Long, b As Long
  24.     Dim width As Integer, height As Integer
  25.     width = pic.width / 2540 * xDPI
  26.     height = pic.height / 2540 * yDPI
  27.     Dim c As Long
  28.     For i = 0 To height - 1
  29.         For j = 0 To width - 1
  30.             c = GetPixel(hMemDC, j, i)
  31.             r = (c And 16711680) \ 65536
  32.             g = (c And 65280) \ 256&
  33.             b = (c And 255&)
  34.             r = 255 - r
  35.             g = 255 - g
  36.             b = 255 - b
  37.             SetPixel hMemDC, j, i, RGB(r, g, b)
  38.         Next
  39.     Next
  40.     SelectObject hMemDC, oldObj
  41.     DeleteDC hMemDC
  42.     SavePicture pic, "yourpath\2.bmp"
  43. End Sub
复制代码
实验效果:
屏幕截图 2024-12-23 135259.png


评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-12-24 01:35 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 woxoo 于 2024-12-24 09:19 编辑

麻烦你能将上面OK插件的代码改成将当前PPT的所有的图片反色,对C#不熟,没搞成功。

private void button1_Click(object sender, RibbonControlEventArgs e)
{
     PowerPoint.Application app;
     app = Globals.ThisAddIn.Application;
     string apath = app.ActivePresentation.Path;
     for (int k = 1; k <= app.ActivePresentation.Slides.Count; k++)
     {
         Slide islide = app.ActivePresentation.Slides[k];
         if(islide.Shapes.Count>0)
         {
             for (int m = 1; m <= islide.Shapes.Count; m++)
             {
                 PowerPoint.Shape pic = islide.Shapes[m];
                 if (pic.Type == Microsoft.Office.Core.MsoShapeType.msoPicture)
                 {
                     pic.Copy();
                     PowerPoint.Shape npic = islide.Shapes.PasteSpecial(PowerPoint.PpPasteDataType.ppPastePNG)[1];
                     pic.ScaleHeight(1f, Office.MsoTriState.msoFalse, Office.MsoScaleFrom.msoScaleFromMiddle);
                     pic.Export(apath + @"xshape.png", PowerPoint.PpShapeFormat.ppShapeFormatPNG);
                     Bitmap bmp0 = new Bitmap(apath + @"xshape.png");
                     for (int i = 0; i < bmp0.Width; i++)
                     {
                         for (int j = 0; j < bmp0.Height; j++)
                         {
                             Color color = bmp0.GetPixel(i, j);
                             int nr = 0, ng = 0, nb = 0;
                             int na = color.A;
                             if (na != 0)
                              {
                                 nr = 255 - color.R;
                                 ng = 255 - color.G;
                                 nb = 255 - color.B;
                                 bmp0.SetPixel(i, j, Color.FromArgb(na, nr, ng, nb));
                              }
                         }
                     }
                     bmp0.Save(apath + @"xshape2.png");
                     PowerPoint.Shape pic2 = islide.Shapes.AddPicture(apath + @"xshape2.png", Office.MsoTriState.msoFalse, Office.MsoTriState.msoTrue, pic.Left, pic.Top + pic.Height / 2 - npic.Height / 2, npic.Width, npic.Height);
                     npic.Delete();
                     bmp0.Dispose();
                     File.Delete(apath + @"xshape.png");
                     File.Delete(apath + @"xshape2.png");
                     pic.Delete();
                 }
             }
         }
     }
}



运行时这段代码 PowerPoint.Shape npic = islide.Shapes.PasteSpecial(PowerPoint.PpPasteDataType.ppPastePNG)[1];报错

TA的精华主题

TA的得分主题

发表于 2024-12-24 14:31 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
woxoo 发表于 2024-12-24 01:35
麻烦你能将上面OK插件的代码改成将当前PPT的所有的图片反色,对C#不熟,没搞成功。

private void butto ...

我没在你原来的基础上修改,你就是需要将PPT里面的图片都反色吧,就按这个要求给你写了一个。不需要把文件存来存去,借用粘贴板来操作。
另外就是这个GetPixel和SetPixel方法的效率可能有点低,所以PPT图片多了,效率会比较低(我做实验的例子才6张图片,就用了快3s了吧)。
反色.gif
代码:
  1.             List<Shape> pics = new List<Shape> { };
  2.             foreach (Slide sld in Globals.ThisAddIn.Application.ActivePresentation.Slides)
  3.             {
  4.                 foreach (Shape sp in sld.Shapes)
  5.                 {
  6.                     if (sp.Type == MsoShapeType.msoPicture) pics.Add(sp);
  7.                 }
  8.             }
  9.             foreach (Shape sp in pics)
  10.             {
  11.                 if (sp.Type == MsoShapeType.msoPicture)
  12.                 {
  13.                     Clipboard.Clear();
  14.                     sp.Copy();
  15.                     Bitmap bmp = (Bitmap)Clipboard.GetImage();
  16.                     for (int j = 0; j < bmp.Height; j++)
  17.                     {
  18.                         for (int k = 0; k < bmp.Width; k++)
  19.                         {
  20.                             Color pCol = bmp.GetPixel(k, j);
  21.                             pCol = Color.FromArgb(255, 255 - pCol.R, 255 - pCol.G, 255 - pCol.B);
  22.                             bmp.SetPixel(k, j, pCol);
  23.                         }
  24.                     }
  25.                     Clipboard.Clear();
  26.                     Clipboard.SetData(nameof(Bitmap), bmp);
  27.                     Shape copySp = sp.Parent.Shapes.PasteSpecial(PpPasteDataType.ppPasteBitmap, MsoTriState.msoFalse)[1];
  28.                     copySp.Left = sp.Left; copySp.Top = sp.Top;
  29.                     sp.Delete();
  30.                 }
  31.             }
复制代码


TA的精华主题

TA的得分主题

 楼主| 发表于 2024-12-24 23:12 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Enocheasty 发表于 2024-12-24 14:31
我没在你原来的基础上修改,你就是需要将PPT里面的图片都反色吧,就按这个要求给你写了一个。不需要把文 ...

再次感谢!

TA的精华主题

TA的得分主题

发表于 2024-12-29 10:50 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
Enocheasty 发表于 2024-12-23 13:53
其实这不是转不转的问题,这是没有可转化性的,在VBA里面创建一个可以编辑的位图对象还是不容易的。VBA本身 ...

老师是高手,我的曼德布罗集画的有点问题,没出现真正的图。太极图少两个眼睛,麻烦高手补充一下了。
另外老师的图片的反色程序不错。能否出个帖子把“油画,木刻,浮雕,边缘,模糊,魔术,负片,灯光,黑白,灰度“等图像效果,像刚才的帖子一样,程序贴出来?

曼德布罗集太极图.rar

21.04 KB, 下载次数: 9

TA的精华主题

TA的得分主题

发表于 2024-12-29 11:49 | 显示全部楼层
dongdonggege 发表于 2024-12-29 10:50
老师是高手,我的曼德布罗集画的有点问题,没出现真正的图。太极图少两个眼睛,麻烦高手补充一下了。
另 ...

兄弟,太为难我了,我对图像处理涉猎不深。这个帖子的反色是个很简单的做法。上面的VBA实现反色,难点也不在反色算法,而是创建一个可编辑的位图对象。所以这个跟做反色、木刻、油画、模糊这些根本不是一个事。
另外,我对VBA也是越来越陌生了,我现在用C#用习惯了,要我改去研究VBA,我都没啥动力。VBA能做到事,C#都能做到,VBA难做的事,C#也是简简单单的。

TA的精华主题

TA的得分主题

发表于 2024-12-29 12:51 | 显示全部楼层
dongdonggege 发表于 2024-12-29 10:50
老师是高手,我的曼德布罗集画的有点问题,没出现真正的图。太极图少两个眼睛,麻烦高手补充一下了。
另 ...

太极图你就按照自己设计的画圆画弧就好了。你能画出来大圆,小圆只是圆心和半径不同而已。
建议你能做一个通用的画圆的子程序,其实就只需要给几个参数,分别调用几次这个画圆的函数就好了。还有,精度不需要那么高,高了除了运算慢,没有任何作用。表现都一样。
  1. Sub 太极图()
  2.         DrawArc 300, 300, 100, 0, 360, 0.1
  3.         DrawArc 350, 300, 50, 180, 360, 0.1
  4.         DrawArc 250, 300, 50, 0, 180, 0.1
  5.         DrawArc 250, 300, 10, 0, 360, 0.2
  6.         DrawArc 350, 300, 10, 0, 360, 0.2
  7. End Sub

  8. Sub DrawArc(x0 As Single, y0 As Single, r As Single, startAngle As Single, endAngle As Single, precision As Double)
  9.         Const pi = 3.1415926
  10.         Dim sAng As Single, eAng As Single
  11.         sAng = pi * startAngle / 180
  12.         eAng = pi * endAngle / 180
  13.         Dim xx As Double, yy As Double, x As Double, y As Double
  14.         xx = r * Cos(sAng) + x0
  15.         yy = r * Sin(sAng) + y0
  16.         sAng = sAng
  17.         For i = sAng To eAng Step precision
  18.                 x = x0 + r * Cos(i)
  19.                 y = y0 + r * Sin(i)
  20.                 With SlideShowWindows(1).View
  21.                         .PointerColor.RGB = vbRed
  22.                         .DrawLine xx, yy, x, y
  23.                 End With
  24.                 xx = x
  25.                 yy = y
  26.         Next i
  27. End Sub
复制代码

屏幕截图 2024-12-29 124953.png

另外,曼德布罗集是一个分形,需要递归迭代,绘制这个东西感觉没啥意义,我之前打算绘制一些分形的,但是后面觉得分形迭代耗费资源挺大的,实用性不强。所以就没做了。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2024-12-29 16:27 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
我都是抄程序,感谢老师。

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-12-29 21:55 | 显示全部楼层
Enocheasty 发表于 2024-12-29 11:49
兄弟,太为难我了,我对图像处理涉猎不深。这个帖子的反色是个很简单的做法。上面的VBA实现反色,难点也 ...

想问一下,在C#里对数学公式可以直接操作不
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

1234

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2025-2-13 14:44 , Processed in 0.041212 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表