Hola @RubenDario
Faltaría que en cada línea dentro del With le pongas un punto al inicio
With Hoja1
.Range("B6:B18,F6:F18,J6:J18").Select
.Range("J6").Activate
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
.Selection.ClearContents
.Range("A1").Select
End With
Sin embargo, lo que yo haría (si fuese mi proyecto)... te ofrezco varias soluciones.
No asignarlo a una combinación de teclas, mejor ponerlo en una forma o botón.
Modificar tu libro con la app Custom UI Editor o similar y adicionar un botón en el Ribbon, estará visible solo cuando el libro esté activo.
Al principio de tu código pondría algo como: If Thisworkbook.Name <> ActiveWorkbook.Name Then Exit sub
Por
DiegoPC, · publicado
Hola, tengo un juego de Poker que funciona perfectamente.
Pero lo copio a un Mac y el juego lo puedo modificar a mi gusto pero las imágenes del cubilete (como si se moviera) no funciona, solo las imágenes,
que parte del código debería modificar ? envío parte del programa, la macro en cuestión.
Sub Tirar()
Dim COLUMNAS As String
Dim DADOS As String,
DADO As Integer
Dim y As Integer, d As Integer '--
Randomize Range("A1").Select
COLUMNAS = "FGHGHGI" 'Columna de la imagen del cubilete
DADOS = "JKLMNO" 'Columna de la imagen de los dados Visualizar
False For y = 1 To Len(COLUMNAS)
ActiveSheet.Shapes.Range("CUBILETE").Select
Selection.Formula = "=" & "'.'!" & Mid(COLUMNAS, y, 1) & 4
ActiveCell.Select If y = Len(COLUMNAS) Then
Application.ScreenUpdating = False
Visualizar True 'uf = Range("E" & Rows.Count).End(xlUp).Row + 1 'Range("E" & uf) = uf - 6
For d = 1 To 5
DADO = Int((6 * Rnd) + 1)
ActiveSheet.Shapes.Range("DADO" & d).Select
Selection.Formula = "=" & "'.'!" & Mid(DADOS, DADO, 1) & 8 'Range("E" & uf).Offset(0, DADO) = Range("E" & uf).Offset(0, DADO) + 1
Next 'Range("L" & uf) = Range("F" & uf) * 6 _ + Range("G" & uf) * 5 _ + Range("H" & uf) * 4 _ + Range("I" & uf) * 3 _ + Range("J" & uf) * 2 _ + Range("K" & uf)
End If
Application.Wait (Now + TimeValue("00:00:01"))
Next ActiveCell.Select Application.ScreenUpdating = True
End Sub