Попробуйте вот это

Попробуйте мой макрос, для генерации фона к рабочему столу Виндоус. Вставляете в VB для Word, и выполняете на чистом листе нового документа. Потом жмёте кнопку захвата экрана на клавиатуре. И уже в Paint Brash выделяете картинку узора, обрезаете ненужное. И сохраняете. Потом делаете этот фрагмент в качестве обоев на рабочий стол. Ставите режим «Замостить». И получаете Красоту!

Можно масштаб на листе Word-а поменять: хочешь больше, хочешь меньше. В результате клетки на обоях будут тоже разные.

Пользуйтесь!


Sub NewMacros()
Randomize Timer

For i% = 1 To 27
    Selection.TypeParagraph
Next i%

Dim xn As Integer, xk As Integer, yn As Integer, yk As Integer
xn = 86
xk = 551
yn = 58
yk = 350

Dim a1 As Integer, a2 As Integer, a3 As Integer
Dim b1 As Integer, b2 As Integer, b3 As Integer
Dim c1 As Integer, c2 As Integer, c3 As Integer

a1 = Int(Rnd * 256): a2 = Int(Rnd * 256): a3 = Int(Rnd * 256)
b1 = Int(Rnd * 256): b2 = Int(Rnd * 256): b3 = Int(Rnd * 256)
c1 = Int(Rnd * 256): c2 = Int(Rnd * 256): c3 = Int(Rnd * 256)

For i% = xn To xk Step 3
Set myDocument = ActiveDocument
With myDocument.Shapes.AddLine(i%, yn, xk + xn - i%, yk).Line
    .DashStyle = msoLineSolid
    .ForeColor.RGB = RGB(a1, a2, a3)
End With
i% = i% + 1

With myDocument.Shapes.AddLine(i%, yn, xk + xn - i%, yk).Line
    .ForeColor.RGB = RGB(b1, b2, b3)
End With
i% = i% + 1

With myDocument.Shapes.AddLine(i%, yn, xk + xn - i%, yk).Line
    .ForeColor.RGB = RGB(c1, c2, c3)
End With
i% = i% - 2

Next i%

a1 = Int(Rnd * 256): a2 = Int(Rnd * 256): a3 = Int(Rnd * 256)
b1 = Int(Rnd * 256): b2 = Int(Rnd * 256): b3 = Int(Rnd * 256)
c1 = Int(Rnd * 256): c2 = Int(Rnd * 256): c3 = Int(Rnd * 256)

For i% = yn To yk Step 3
With myDocument.Shapes.AddLine(xk, i%, xn, yk + yn - i%).Line
    .ForeColor.RGB = RGB(a1, a2, a3)
End With
i% = i% + 1

With myDocument.Shapes.AddLine(xk, i%, xn, yk + yn - i%).Line
    .ForeColor.RGB = RGB(b1, b2, b3)
End With
i% = i% + 1

With myDocument.Shapes.AddLine(xk, i%, xn, yk + yn - i%).Line
    .ForeColor.RGB = RGB(c1, c2, c3)
End With
i% = i% - 2

Next i%

End Sub



P.S.

Это та самая программулька, которая у меня раньше под ДОС из под QBasic-а работала. Но она была ограничена режимом SCREEN 12 = 640х480 16 colors. А этот макрос за видео режим не завязан. И цветов в нём 256 * 256 * 256 = 16777216 шт. Однако замечено мною, что цвета получаются более однообразные, чем в старой программульке под ДОС. Сглаживаются на высоком разрешении, видимо.

Вот так.

Если поменять размер области вывода линий: xn, yn -- xk, yk = то можно программно увеличивать или уменьшать рисунок. Но зачем? Если легче просто изменить масштаб на листе Word-а.

Я нашинковал себе 20 шт. разных и по цвету и по размеру. И установил флажок в Персонализации «в случайном порядке». И теперь он каждый час мне меняет на рабочем столе обои…

Мне нравится такая «кофейная» расцветочка. (Смотри картинку).

…
«Я голодный! Посудите сами –
Здесь у них лишь кОфЭ, да омлет!
Клетки, как круги перед глазами,
Королей я путаю с Тузами,
И с дебютом путаю дуплет!

Есть примета. Вот я и рискую. –
Первый раз должно мне повезти!
Да я его замучу, зашахую!
(Мне бы только дамку провести)…
»

В.Высоцкий





23:05:25 28.09.2023          1D0610F33C9C



P.P.S.

А вот вторая версия того же Макроса. Отличается размером рисунка (он стал более квадратным) и рисует на формате Web-странички. Это даёт возможность установить цветной фон листа. Фон выбирается так же случайным образом. При этом цвет фона обязательно присутствует в обоих секторах заполнения рисунка в виде цвета одной из трёх линий (второй по счёту очерёдности). Это устраняет эффект «просвечивания» сквозь рисунок белого листа. Как это получалось в первой версии. Однако, мной замечено, что при сохранении файла в формате Web-странички в папке лежит GIF-файл, у которого фон ЧЁРНЫЙ. Но виден он «чёрным» только в Paint Brash-е. А просмотрщик стандартный Виндоусовский оставляет на просмотре фон БЕЛЫЙ. И рисунок выглядит хуже, чем он есть на самом деле.

К тому же у него края фона выходят за размер линий. А в этом случае «плиточки» на обоях Виндоус оказываются разделёнными толстыми чёрными «швами». Просто швах дело!

Не имеет смысла так же сохранять в формате Web. Файл Web-странички получается огромным (ведь каждая линия описывается отдельно!), сравните Макрос – в нём всё свёрнуто в два цикла For!!! А преобразование в HTM-формат «разворачивает» эти циклы в линейное описание… Жуть!

Внимательнее надо. Товарищи! Общим видом овладели. Теперь подробности не надо пропускать.



Sub NewMacros()
Randomize Timer

For i% = 1 To 17
    Selection.TypeParagraph
Next i%

Dim xn As Integer, xk As Integer, yn As Integer, yk As Integer
xn = 86
xk = 551
yn = 27
yk = 380

Dim a1 As Integer, a2 As Integer, a3 As Integer
Dim b1 As Integer, b2 As Integer, b3 As Integer
Dim c1 As Integer, c2 As Integer, c3 As Integer

a1 = Int(Rnd * 256): a2 = Int(Rnd * 256): a3 = Int(Rnd * 256)
b1 = Int(Rnd * 256): b2 = Int(Rnd * 256): b3 = Int(Rnd * 256)
c1 = Int(Rnd * 256): c2 = Int(Rnd * 256): c3 = Int(Rnd * 256)

ActiveDocument.Background.Fill.ForeColor.RGB = RGB(a2, b2, c2)
ActiveDocument.Background.Fill.Visible = msoTrue
ActiveDocument.Background.Fill.Solid

For i% = xn To xk Step 3
Set myDocument = ActiveDocument
With myDocument.Shapes.AddLine(i%, yn, xk + xn - i%, yk).Line
    .DashStyle = msoLineSolid
    .ForeColor.RGB = RGB(a1, b1, c1)
    .Weight = 1
End With
i% = i% + 1

With myDocument.Shapes.AddLine(i%, yn, xk + xn - i%, yk).Line
    .ForeColor.RGB = RGB(a2, b2, c2)
    .Weight = 1
End With
i% = i% + 1

With myDocument.Shapes.AddLine(i%, yn, xk + xn - i%, yk).Line
    .ForeColor.RGB = RGB(a3, b3, c3)
    .Weight = 1
End With
i% = i% - 2

Next i%

a1 = Int(Rnd * 256): a3 = Int(Rnd * 256)
b1 = Int(Rnd * 256): b3 = Int(Rnd * 256)
c1 = Int(Rnd * 256): c3 = Int(Rnd * 256)

For i% = yn To yk Step 3
With myDocument.Shapes.AddLine(xk, i%, xn, yk + yn - i%).Line
    .ForeColor.RGB = RGB(a1, b1, c1)
    .Weight = 1
End With
i% = i% + 1

With myDocument.Shapes.AddLine(xk, i%, xn, yk + yn - i%).Line
    .ForeColor.RGB = RGB(a2, b2, c2)
    .Weight = 1
End With
i% = i% + 1

With myDocument.Shapes.AddLine(xk, i%, xn, yk + yn - i%).Line
    .ForeColor.RGB = RGB(a3, b3, c3)
    .Weight = 1
End With
i% = i% - 2

Next i%

End Sub





22:40:05 01.10.2023          1C34D311200