Public Function CMYK_From_Cell(cl As Range, CMYK_Component As String) As Double
    Q = cl.Interior.Color
    S = "000000"
    H = Hex(Q)
    Mid(S, 7 - Len(H)) = H

    r = Right(S, 2)
    g = Mid(S, 3, 2)
    B = Left(S, 2)

    r = CLng("&H" & r) / 255
    g = CLng("&H" & g) / 255
    B = CLng("&H" & B) / 255
    
    Black = Math.Round(Application.Min(1 - r, 1 - g, 1 - B), 2)
    Cyan = (1 - r - Black) / (1 - Black)
    Magenta = (1 - g - Black) / (1 - Black)
    Yellow = (1 - B - Black) / (1 - Black)

    Select Case CMYK_Component
    Case "C"
        CMYK_From_Cell = IIf(Cyan < 0, 0, Math.Round(Cyan, 2))
    Case "M"
        CMYK_From_Cell = IIf(Magenta < 0, 0, Math.Round(Magenta, 2))
    Case "Y"
        CMYK_From_Cell = IIf(Yellow < 0, 0, Math.Round(Yellow, 2))
    Case "K"
        CMYK_From_Cell = IIf(Black < 0, 0, Math.Round(Black, 2))
    End Select

Sub ГЕНЕРАТОР_ПОКРАСКИ()

 Dim sch_VERT, sch, lst_gen, lst_kod, PUT_FILE, PUT_FILE_out As Variant
 
PUT_FILE = Application.ActiveWorkbook.Path + "\"
PUT_FILE_out = PUT_FILE + "POKRASKA.TXT"

    Sheets("POKRASKA").Select
    Range("J2:N21").Select
    Selection.Copy

ActiveWorkbook.SaveAs Filename:=PUT_FILE_out, FileFormat:=xlText 
        MsgBox "ГОТОВО"

Sub Макрос1()

   
   q = Cells(1, 1).Interior.Color 'крашенная ячейка
    Cells(4, 5).Value = q 'для визуализации
    s = "000000"
    h = Hex(q)
    Cells(5, 5).Value = h 'для визуализации
    Mid(s, 7 - Len(h)) = h
    
    Cells(6, 5).Value = h 'для визуализации

    r = Right(s, 2)
    g = Mid(s, 3, 2)
    B = Left(s, 2)
    
    Cells(7, 5).Value = r 'не деленное на 255
    Cells(8, 5).Value = g 'не деленное на 255
    Cells(9, 5).Value = B 'не деленное на 255

    r = CLng("&h" & r) / 255
    g = CLng("&h" & g) / 255
    B = CLng("&h" & B) / 255
               
        
    Black = Application.Min(1 - r, 1 - g, 1 - B)
    Cyan = (1 - r - Black) / (1 - Black)
    Magenta = (1 - g - Black) / (1 - Black)
    Yellow = (1 - B - Black) / (1 - Black)

   
 
Cells(10, 5).Value = r 'для визуализации
Cells(11, 5).Value = g 'для визуализации
Cells(12, 5).Value = B 'для визуализации

Cells(13, 5).Value = Cyan 'полученное значение
Cells(14, 5).Value = Magenta 'полученное значение
Cells(15, 5).Value = Yellow 'полученное значение
Cells(16, 5).Value = Black 'полученное значение
End Sub

Sub Макрос1()
'
P = 250
R = 320
a = 0
b = 0

c = 15
d = c

n = 1
m = 1

For Y = 1 To P

For Z = 1 To R
Cells(n, m).Select
ActiveSheet.Shapes.AddShape(msoShapeOval, a, b, c, d).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = Cells(n, m).Interior.Color
.Transparency = 0
.Solid
Selection.ShapeRange.Line.Visible = msoFalse
End With
a = a + c
m = m + 1

Next
a = 0
m = 1
n = n + 1
b = b + c

Next          
           Cells.Interior.Color = RGB(255, 255, 255)
End Sub

 G1Z-1
G1Z1

M106 P1 S200
G04 P30
M107
G04 P30

Sub Макрос1()
'
' Макрос1 Макрос


 L = Cells(1, 1).Value
 n = 5
 m = 5
 
 For W = 1 To L 'количество ячеек вправо

    Cells(m, n).Select
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(m, n).Select
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove        
   
   n = n + 4
   m = m + 4
         
  Next W
  End Sub

' Работа ШД каретки ' 
 For W = 1 To V 
 DlPortWritePortUchar &H378, 0 
 DlPortWritePortUchar &H378, 33 

 PauseTime = O 
 Start = Timer 

 Do While Timer < Start + PauseTime 
 DoEvents 
 Loop 
 Finish = Timer 
 TotalTime = Finish - Start 
 DlPortWritePortUchar &H378, 0 

 DlPortWritePortUchar &H378, 34 

 PauseTime = O 
 Start = Timer 
 Do While Timer < Start + PauseTime 
 DoEvents 
 Loop 
 Finish = Timer 
 TotalTime = Finish - Start 
 DlPortWritePortUchar &H378, 0 

 DlPortWritePortUchar &H378, 36 

 PauseTime = O 
 Start = Timer 
 Do While Timer < Start + PauseTime 
 DoEvents 
 Loop 
 Finish = Timer 
 TotalTime = Finish - Start 
 DlPortWritePortUchar &H378, 0 

 DlPortWritePortUchar &H378, 40 

 PauseTime = O 
 Start = Timer 
 Do While Timer < Start + PauseTime 
 DoEvents 
 Loop 
 Finish = Timer 
 TotalTime = Finish - Start 
 DlPortWritePortUchar &H378, 0 

 Next W

For m = 1 To L 
   For n = 1 To Z 

       If Cells(m, n).Value = 1 Then 

         Cells(10, 10).Interior.ColorIndex = 6 

      End If 

      Cells(m, n + 1).Select 
    Next n 
   n = 1 
   Cells(m + 1, n).Select 
 Next m