Red de conocimiento informático - Conocimiento de la instalación - Solicitando: VBA Programación muy interesante: Utilice el código VBA para realizar una línea en forma de corazón dibujada con 5 caracteres L, O, V, E, *. Gracias, Children's Shoes.

Solicitando: VBA Programación muy interesante: Utilice el código VBA para realizar una línea en forma de corazón dibujada con 5 caracteres L, O, V, E, *. Gracias, Children's Shoes.

El siguiente programa puede cumplir con sus requisitos, el efecto se muestra en la imagen adjunta

Private?Sub?Worksheet_SelectionChange(ByVal?Target?As?Range)

¿Const.?=?"8,22,8,23,7,24,6,24,5,25,4,26,3,27,3,28,2,29,2,30,2, 31,2 ,32,2,33,2,34,2,35,2,36,3,37,4,38,5,39,6,40,7,"?&?_

" 41,8,42,9,42,10,43,11,43,12,43,13,43,14,43,15,43,16,43,17,43,18,43,19 ,43, 20,42,21,41,22,41,23,41,24,40,"?&?__

"25,40,26,39,27,39,28, 38,29 ,38,30,37,31,37,32,36,33,36,33,35,34,35,34,34,35,34,35,33,36,33,36,32, 37,32 ,"?&?__

"37,31,38,31,38,30,39,30,40,29,41,28,42,27,43,26,44 ,25, 45,24,46,23,46,22,47,21,47,20,48,19,48,18,49,17,49,"?&?_

" 16,50 ,15,50,14,49,14,48,14,47,14,46,14,45,13,44,13,43,13,42,13,41,13,40,13, 39,13 ,38,12,37,12,36,12,35,11,"?&?__

"34,11,33,10,32,10,31,9,30 ,8, 29,7,28,7,28,6,27,6,26,5,25,5,25,4,24,4,23,4,22,3,21,2,20,2 ,19, 2,18,1,17,1,16,"?&?_

"1,15,1,14,1,13,1,12,2,11,2, 10,2 ,9,2,8,3,7,3,7,4,6,4,5,5,4,6,3,7,2,8,2,9,2,10,1, 11,1 ,12,1,13,1,14,2,15,2,16,"?&?__

"2,17,3,18,4,19,5,20 ,6, 21,13,16,13,15,13,14,13,13,14,12,15,11,16,11,17,11,18,11,19,11,19,12,20 ,12, 20,13,20,14,"?&?_

"20,15,20,16,19,17,18,18,17,19,16,20,15, 20,14 ,20,13,20,13,19,13,18,14,17,15,17,16,16,17,15,18,15,19,14,21,14,"?&? _

"22,14,23,13,24,12,25,11,25,10,25,9,24,8,23,9,23,10,23,11,24 ,13, 25,14,25,15,24,16,23,17,22,18,21,18,20,19,20,"?&?__

"20,21, 20,22 ,19,23,19,24,19,25,19,25,20,25,21,24,22,23,22,22,23,21,23,20,23,19,22, 20,21,21,21,22,21,24,23,23,"?

&?__

"23,23,24,22,24,22,25,21,25,21,26,20,26,20,27,20,28,21,28,22 ,27,23,27,23,26,24,26,25,26,25,27,25,28,24,29,23,"?&?__

"30,22, 30,21,31,20,31,19,30,20,29,21,29,22,29,23,29,23,31,22,32,21,33,20,33,22,33, 23,33,23,34,23,35,22,36,21,"?&?__

"37,20,37,19,36,19,35,20,34,24 ,33,25,33,25,34,25,35,25,36,24,36,23,37,22,38,21,39,20,40"

¿Const?DelayValue? =?5000

Const?COffset?=?15

Const?ROffset?=?10

¿Dim?DD,?Love(),?I? Como?Entero,?J?Como?Entero

Amor?=?Array("*",?"l",?"o",?"v",?"e")

Application.DisplayAlerts?=?False

ActiveSheet.Cells.ClearContents

ActiveSheet.Rows.RowHeight?=?8

ActiveSheet.Columns. ColumnWidth?=?1

ActiveSheet.Cells.Font.ColorIndex?=?3

ActiveSheet.Cells.Font.Size?=?6

Aplicación. WindowState?=?xlMaximizado

Con?ActiveWindow

.DisplayGridlines?=?False

.DisplayHeadings?=?False

.DisplayHorizontalScrollBar ?=?False

.DisplayVerticalScrollBar?=?False

.DisplayWorkbookTabs?=?False

Fin?Con

Con?Aplicación

.DisplayFormulaBar?=?False

.DisplayStatusBar?=?False

Fin?Con

Application.CommandBars("Estándar" ).Visible?=?False

Application.CommandBars("Formatting").Visible?=?False

Application.CommandBars("Visual?Basic").Visible?=? Falso

Application.CommandBars("Dibujo").Visible?=?False

'Application.CommandBars("Hoja de trabajo?Menu?Bar").Visible?=?False

DD?=?Dividir(Datos,?",")

Celdas(1,?1).Seleccionar

¿Para?

I?=?0?To?UBound(DD)?Step?2

Para?J?=?1?To?DelayValue

DoEvents

Siguiente

Celdas(Val(DD(I))?+?ROffset,?Val(DD(I?+?1))?+?COffset)?=?Amor((I?/?2) ?Mod?5)

Siguiente

Fin?Sub