
Perks of Pay Someone To Take My Online Class
Access
Publicado el 2 de Diciembre del 2023 por Adriana
42 visualizaciones desde el 2 de Diciembre del 2023
Sub RemoveWhiteBackground()
Dim doc As Document
Dim sr As ShapeRange
Dim shape As shape
Dim bmp As Bitmap
Dim x As Long, y As Long
Dim bgColor As Long ' Utilizamos Long para almacenar el valor RGB
Dim tolerance As Integer
Set doc = ActiveDocument
Set sr = doc.ActivePage.Shapes.All
' Obtener el valor RGB para el color blanco
bgColor = RGB(255, 255, 255)
' Definir la tolerancia para el rango de colores que consideras "blanco"
tolerance = 30
For Each shape In sr
If shape.Type = cdrBitmapShape Then
Set bmp = shape.Bitmap
For x = 1 To bmp.SizeWidth ' Usar SizeWidth en lugar de GetWidth
For y = 1 To bmp.SizeHeight ' Usar SizeHeight en lugar de GetHeight
If ColorDistance(bmp.Pixel(x, y), bgColor) < tolerance Then
bmp.Pixel(x, y) = RGB(0, 0, 0) ' Cambiar el píxel a negro
End If
Next y
Next x
End If
Next shape
End Sub
Function ColorDistance(color1 As Color, color2 As Long) As Double
Dim redDiff As Double
Dim greenDiff As Double
Dim blueDiff As Double
redDiff = color1.Red - GetRValue(color2)
greenDiff = color1.Green - GetGValue(color2)
blueDiff = color1.Blue - GetBValue(color2)
ColorDistance = Sqr(redDiff ^ 2 + greenDiff ^ 2 + blueDiff ^ 2)
End Function