O código a seguir é perfeito.
Sub Macro1()
Dim mySecond As Double
mySecond = 75
Dim myMinute As Double
myMinute = mySecond / 86400
'Output of the following code is 01:15 which is perfect.
Debug.Print Format(myMinute, "nn:ss")
End Sub
Quero encurtar o código acima omitindo as seguintes linhas.
Dim myMinute As Double
myMinute = mySecond / 86400
É possível?
1) Execute o seguinte código no aplicativo Excel .
Sub Macro1()
'Delete all shapes if exists
For i = ActiveSheet.Shapes.Count To 1 Step -1
ActiveSheet.Shapes(i).Delete
Next i
'Add a Rectangle
With ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, Left:=20, Top:=20, Width:=200, Height:=120)
.Name = "myRectangle"
End With
'Make some formatting to the myRectangle
With ActiveSheet.Shapes("myRectangle")
.Line.Visible = msoTrue
.Line.ForeColor.RGB = vbBlue
.Line.Weight = 5
.Fill.UserPicture "https://upload.wikimedia.org/wikipedia/en/b/ba/Flag_of_Germany.svg"
End With
End Sub
2) Verifique se você obteve o seguinte retângulo em sua planilha do Excel .
3) Estou procurando uma macro que me dê a seguinte imagem.
Como você pode entender, eu quero fazer algumas margens entre as bordas e a bandeira .
Quero criar uma tabela de 200 linhas no aplicativo PowerPoint.
O código a seguir gera este erro: Erro de tempo de execução 424: Objeto requerido
Como resolver esse erro?
Public Sub Macro1()
'Delete all slides
For i = ActivePresentation.Slides.Count To 1 Step -1
ActivePresentation.Slides(i).Delete
Next i
'Add a blank slide
ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutBlank
'Zoom out
ActiveWindow.View.Zoom = 40
'Add a Table
With ActivePresentation.Slides(1).Shapes.AddTable(NumRows:=1, NumColumns:=1, Left:=5, Top:=5, Width:=900, Height:=500)
.Name = "tbl"
End With
'Make 200 rows
While ActivePresentation.Slides(1).Shapes("tbl").Table.Rows.Count < 200
ActivePresentation.Slides(1).Shapes("tbl").Table.Rows.Add
Wend
'Change height for all rows
For i = 1 To ActivePresentation.Slides(1).Shapes("tbl").Table.Rows.Count
ActivePresentation.Slides(1).Shapes("tbl").Table.Rows(i).Height = 8
Next i
'Fill text to the 200 cells
For i = 1 To 200
ActivePresentation.Slides(1).Shapes("tbl").Table.Cell(i, 1).Shape.TextFrame.TextRange.Text = i
Next i
End Sub
A linha a seguir gera um erro.
ActivePresentation.Slides(1).Shapes("tbl").Table.Cell(i, 1).Shape.TextFrame.TextRange.Text = i
1) Cole os seguintes valores nas células A1:B11 da planilha do Excel.
1000 =IF(A1<1500,"NO","YES")
1100 =IF(A2<1500,"NO","YES")
1200 =IF(A3<1500,"NO","YES")
1300 =IF(A4<1500,"NO","YES")
1400 =IF(A5<1500,"NO","YES")
1500 =IF(A6<1500,"NO","YES")
1600 =IF(A7<1500,"NO","YES")
1700 =IF(A8<1500,"NO","YES")
1800 =IF(A9<1500,"NO","YES")
2) Você verá que a primeira célula que contém SIM na coluna B é B6 .
3) Estou procurando alguma fórmula do Excel que me dê B6 sem volátil.
Desde já, obrigado.
Quero adicionar um caractere invisível a uma string de texto.
Dim myString As String
myString = "United States"
Os códigos a seguir não são ok porque os códigos a seguir separam a string em duas partes.
Quero manter a corda em uma parte.
myString = "United" & " " & "States"
myString = "United" & Space(1) & "States"
myString = "United" & Chr(32) & "States"
myString = "United" & Chr(160) & "States"
Deve haver um caráter entre os Estados Unidos e os Estados Unidos, mas esse caráter deve ser invisível.
Deve haver um caráter entre os Estados Unidos e os Estados Unidos e esse caráter deve ocupar espaço.
Qual caractere devo colocar na string a seguir em vez do ponto de interrogação ?
myString = "United?States"
O código a seguir funciona corretamente no Excel .
Mas estou procurando uma solução em Power Point .
Como encontrar um valor máximo em um dicionário no aplicativo Power Point ?
Sub Macro1()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For i = 1 To 10
dict.Add Key:=i, Item:=i
Next i
For i = 0 To dict.Count - 1
Debug.Print dict.Keys()(i), dict.Items()(i)
Next i
'The following two lines works properly in Excel.
'But I am looking for Power Point solution.
Debug.Print Application.Max(dict.Items)
Debug.Print WorksheetFunction.Max(dict.Items)
End Sub
Execute a seguinte macro.
Sub Macro1()
MsgBox "Hello"
End Sub
Quando a MsgBox aparecer, pressione as teclas Ctrl+C no teclado.
Abra um arquivo do Bloco de Notas e pressione as teclas Ctrl+V no teclado.
Como você pode ver, você pode copiar do MsgBox e colar no arquivo do Bloco de Notas .
Agora vamos fazer o segundo cenário.
Execute a seguinte macro.
Sub Macro2()
Dim myNumber As Integer
myNumber = 20
Dim yourNumber As Integer
yourNumber = 0
'In mathematics, a number can not be divided by zero. So the following code must throw an error.
Dim resultNumber As Integer
resultNumber = myNumber / yourNumber
End Sub
Quando a MsgBox aparecer, pressione as teclas Ctrl+C no teclado.
Abra um arquivo do Bloco de Notas e pressione as teclas Ctrl+V no teclado.
Como você pode ver, você NÃO consegue copiar do MsgBox e colar no arquivo do Bloco de Notas .
Minha dúvida: Como copiar mensagens de erro enviadas pelo Runtime Engine para a área de transferência do Windows conforme dou um exemplo no segundo cenário.
Adicione um UserForm ao arquivo Power Point.
Coloque um CommandButton e um ListBox nesse UserForm .
Coloque os seguintes códigos no UserForm .
Public Sub UserForm_Initialize()
UserForm1.ListBox1.AddItem "msoShapePentagon"
UserForm1.ListBox1.AddItem "msoShapeRectangle"
UserForm1.ListBox1.AddItem "msoShapeSmileyFace"
End Sub
'''''''''''''''''''''''''''''''
Public Sub CommandButton1_Click()
MsgBox UserForm1.ListBox1.Value
UserForm1.Hide
Call Macro2
End Sub
Coloque os seguintes códigos no Módulo1 do arquivo Power Point.
Public Sub Macro1()
UserForm1.Show
End Sub
'''''''''''''''''''''''''''''''
Public Sub Macro2()
ActivePresentation.Slides.Add 1, ppLayoutBlank
Dim myVariant As Variant
myVariant = UserForm1.ListBox1.Value
MsgBox myVariant
'This line is okey
'ActivePresentation.Slides(1).Shapes.AddShape Type:=msoShapeRectangle, Left:=0, Top:=0, Width:=480, Height:=100
'This line gives an error
ActivePresentation.Slides(1).Shapes.AddShape Type:=myVariant, Left:=0, Top:=0, Width:=480, Height:=100
End Sub
Execute Macro1 e selecione msoShapeRectangle em ListBox que faz parte do UserForm e pressione CommandButton .
Esta é a mensagem de erro.
Run-time error 13: Type mismatch
Esta é a linha de erro
ActivePresentation.Slides(1).Shapes.AddShape Type:=myVariant, Left:=0, Top:=0, Width:=480, Height:=100
Então, como posso resolver esse erro?
O código a seguir pressione a tecla TAB três vezes. O código a seguir está ok.
SendKeys "{TAB 3}", True
Como pressionar as teclas Ctrl mais w três vezes?
Eu tentei o seguinte código, mas não funciona.
SendKeys "^w 3", True
Observe que as teclas Ctrl mais w são usadas para fechar a página da Web ativa.
Então, quero fechar as últimas três páginas da web.
Quero limpar o histórico da área de transferência do sistema operacional Windows por meio do comando VBA e PowerShell .
Eu sou um usuário do Windows 10 .
Esta é a linha de comando do PowerShell que limpa o histórico da área de transferência do sistema operacional Windows .
PS C:\Windows\system32> Restart-Service -Name "cbdhsvc*" -force
O link a seguir pode ser útil para entender do que estou falando.
Você conhece algum código VBA que me dê o mesmo resultado das ações acima?
Quer dizer, só quero abrir a tela de configurações do Windows por meio do código VBA .
Observe que sou um usuário do Windows 10 .