Views

...

Important:

Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance.

E-mails

Deixe seu e-mail para receber atualizações...

eBook Promo

VBA Excel - Encontra a palavra e destaca a Linha - Highlighting a row


Inline image 2

Al


Sub SearchWord()
Let nWord = InputBox("Digite a palavra", _
".: A&A",  "Palavra:")

If nWord = cancel Then ' Cancel
    Exit Sub
End If

Cells.Find(_
What:=nWord, _
After:=ActiveCell, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False_
).Select

MsgBox "A Palavra (" & nWord & ") foi localizada", _
vbInformation, _
".: A&A"
End Sub

Reference:

Tags: VBA, Excel, highlighting, search, row

VBA Excel - Conectando-se à distância através do IP

Blog Office VBA | Blog Excel | Blog Access |
Inline image 1

Talvez tenha se deparado com a necessidade de plugar-se a um Banco de Dados à distância, em outra rede, ou num servidor externo à rede que utiliza. Como fazer referência a ele utilizando uma conexão ODBC?

No exemplo a seguir temos a conexão a um banco MySQL. O código abaixo será útil nessa experiência, apenas certifique-se de utilizar a versão correta do Driver de ODBC.

Sub DeleteMySQLDatabase()
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

Let Server_Name = Sheets(3).Range("B24").Value               ' IP number or servername
Let Database_Name = Sheets(3).Range("B21").Value             ' Name of database
Let User_ID = Sheets(3).Range("B25").Value                   ' ID user or username
Let Password = Sheets(3).Range("B23").Value                  ' Password
Let Tabellen = Sheets(3).Range("B22").Value                  ' Name of table to write to
Let auxilia = Sheets(1).Range("L16").Value
Let ID = Sheets(1).Cells(auxilia, "A").Value
Let SQLStr = "DELETE FROM " & Tabellen & " WHERE ID = '" & ID & "';"

Set Cn = New ADODB.Connection

Cn.Open "Driver={MySQL ODBC 3.51 Driver};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
Cn.Execute SQLStr

Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub


Outros artigos:



Reference

Tags: VBA, Excel, SQL, MySQL, ODBC, connect, Database, Banco de Dados, conexão, server, servidor, IP

VBA Excel - alterando os Tipos de um Gráfico - ChartType Property

Inline image 2

Alguns dos Dashboards desenvolvidos no MS Excel, permitem que os usuários mudem o tipo de gráfico visualizado. Isso é muito produtivo quando contribui para a compreensão dos dados. Mas, é importante lembar que alguns tipos de gráficos não ficam disponíveis para as PivotChart Report.

Seria útil saber quais são as propriedades (do tipo constantes), que ChartType do objeto ChartObjects suporta:

xlLine. Line
xlLineMarkersStacked. Stacked Line with Markers
xlLineStacked. Stacked Line
xlPie. Pie
xlPieOfPie. Pie of Pie
xlPyramidBarStacked. Stacked Pyramid Bar
xlPyramidCol. 3D Pyramid Column
xlPyramidColClustered. Clustered Pyramid Column
xlPyramidColStacked. Stacked Pyramid Column
xlPyramidColStacked100. 100% Stacked Pyramid Column
xlRadar. Radar
xlRadarFilled. Filled Radar
xlRadarMarkers. Radar with Data Markers
xlStockHLC. High-Low-Close
xlStockOHLC. Open-High-Low-Close
xlStockVHLC. Volume-High-Low-Close
xlStockVOHLC. Volume-Open-High-Low-Close
xlSurface. 3D Surface
xlSurfaceTopView. Surface (Top View)
xlSurfaceTopViewWireframe. Surface (Top View wireframe)
xlSurfaceWireframe. 3D Surface (wireframe)
xlXYScatter. Scatter
xlXYScatterLines. Scatter with Lines.
xlXYScatterLinesNoMarkers. Scatter with Lines and No Data Markers
xlXYScatterSmooth. Scatter with Smoothed Lines
xlXYScatterSmoothNoMarkers. Scatter with Smoothed Lines and No Data Markers
xl3DArea. 3D Area
xl3DAreaStacked. 3D Stacked Area
xl3DAreaStacked100. 100% Stacked Area
xl3DBarClustered. 3D Clustered Bar
xl3DBarStacked. 3D Stacked Bar
xl3DBarStacked100. 3D 100% Stacked Bar
xl3DColumn. 3D Column
xl3DColumnClustered. 3D Clustered Column
xl3DColumnStacked. 3D Stacked Column
xl3DColumnStacked100. 3D 100% Stacked Column
xl3DLine. 3D Line
xl3DPie. 3D Pie
xl3DPieExploded. Exploded 3D Pie
xlArea. Area
xlAreaStacked. Stacked Area
xlAreaStacked100. 100% Stacked Area
xlBarClustered. Clustered Bar
xlBarOfPie. Bar of Pie
xlBarStacked. Stacked Bar
xlBarStacked100. 100% Stacked Bar
xlBubble. Bubble
xlBubble3DEffect. Bubble with 3D effects
xlColumnClustered. Clustered Column
xlColumnStacked. Stacked Column
xlColumnStacked100. 100% Stacked Column
xlConeBarClustered. Clustered Cone Bar
xlConeBarStacked. Stacked Cone Bar
xlConeBarStacked100. 100% Stacked Cone Bar
xlConeCol. 3D Cone Column
xlConeColClustered. Clustered Cone Column
xlConeColStacked. Stacked Cone Column
xlConeColStacked100. 100% Stacked Cone Column
xlCylinderBarClustered. Clustered Cylinder Bar
xlCylinderBarStacked. Stacked Cylinder Bar
xlCylinderBarStacked100. 100% Stacked Cylinder Bar
xlCylinderCol. 3D Cylinder Column
xlCylinderColClustered. Clustered Cone Column
xlCylinderColStacked. Stacked Cone Column
xlCylinderColStacked100. 100% Stacked Cylinder Column
xlDoughnut. Doughnut
xlDoughnutExploded. Exploded Doughnut
xlLineMarkers. Line with Markers
xlLineMarkersStacked100. 100% Stacked Line with Markers
xlLineStacked100. 100% Stacked Line
xlPieExploded. Exploded Pie
xlPyramidBarClustered. Clustered Pyramid Bar
xlPyramidBarStacked100. 100% Stacked Pyramid Bar

Segue exemplo de como usar essas constantes:


Este exemplo define o tamanho do gráfico de Bolhas num grupo com 200% do tamanho padrão, caso o gráfico esteja no padrão Bolhas 2D.
With Worksheets(1).ChartObjects(1).Chart      If .ChartType = xlBubble Then          .ChartGroups(1).BubbleScale = 200      End If  End With

Reference:

Tags: VBA, Excel, chart, dynamic, Chart Object, Series, Type, Property, chart, Gráfico, tipo, série, objeto , Bolhas, Bubbles

VBA Excel - Encontrando o valor RGB de uma célula - Find RGB Value of a color

Inline image 1

Em certas implementações precisamos seguir o padrão definido pela empresa que nos contratou e isso inclui a paleta de cores que utilizaremos.

Para não corrermos o risco de não utilizarmos exatamente as mesmas cores que são padrão para empresa, podemos utilizar essa pequena, mas muito útil função de identificação do padrão de cor RGB (Red, Green e Blue).

Function rgb_color(cl As Range) As String

Dim rgbc As Long, rc As Long, gc As Long, bc As Long

If cl.Cells.Count = 1 Then

rc = cl.Interior.Color Mod 256

rgbc = Int(cl.Interior.Color / 256)

gc = rgbc Mod 256

bc = Int(rgbc / 256)

rgb_color = "Red - " & rc & " Green - " & gc & " Blue - " & bc

Else

rgb_color = "Please select single cell only"

End If

End Function

Caso desejamos saber qual é o valor RGB da célula A1, digitaremos na célula B1 = rgb_color(A1) 


Reference: Excelvbamacros.com


Tags: VBA, Excel, RGB, color, cor, colour, 

Inline image 1

VBA Excel - Encontrar a primeira célula após uma área congelada - Find The First Cell After Freeze Pane

Inline image 1

Mais uma facilidade num processo de automação.

Sub find_first_cell_after_freeze_pane()

If ActiveWindow.SplitRow = 0 And ActiveWindow.SplitColumn = 0 Then

MsgBox "No freeze Pane Found"

Exit Sub

Else

MsgBox Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Address

End If

End Sub

Reference: Excelvbamacros.com


Tags: VBA, Excel, freeze, panel, cell, first cell

Inline image 1

VBA Excel - Navegue através de todas as pastas de uma planilha, posicionando-se na primeira célula - Navigate through all the worksheet and Press Ctrl + Home . Goto first cell in each worksheet

Inline image 1

Quando estamos trabalhando com muita velocidade em planilhas e temos certa urgência, algumas facilidades são bem vindas para agilizar a nossa produtividade.

Este código tem este propósito, tornar a nossa interação com uma planilhas que contém muitas pastas, mais ágil.

Sub goto_first_cell_in_each_worksheet()

Dim wk As Worksheet

For Each wk In ThisWorkbook.Sheets

wk.Select

If ActiveWindow.SplitRow = 0 And ActiveWindow.SplitColumn = 0 Then

Application.Goto Range("a1")

Exit Sub

Else

Application.Goto Range(Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Address)

End If

Next

ActiveWorkbook.Save

End Sub

Reference: Excelvbamacros.com

Tags: VBA, Excel, Navegue, Goto first, cell, firts cell, each worksheet

Inline image 1

VBA Excel - Misture o conteúdo de diversas planilhas em uma única planilha - Merge data from all sheets from multiple workbooks and paste them in single worksheet

Inline image 1

Quando estamos criando bases de dados que envolvem informações de bases legadas, ou planilhas antigas, onde em alguns casos precisamos juntas informações de centenas de planilhas, saber automatizar esta parte do processo parece ser bem importante.

Se você não for precisar deste código agora, pelo menos deixa essa página guardada nos seus 'Favoritos', certamente a utilizará no futuro.

Caso você deseja copiar os dados a partir de múltiplas planilhas e colá-los numa única e simples planilhas, poderá usar esse código.

Por exemplo, caso você tenha diversas planilhas gravadas numa única pasta, tal como:

a.xlsx

b.xlsx

c.xlsx

d.xlsx


E em cada uma das planilhas você tivesse múltiplas pastas tais como: Jan, Fev, Mar etc., e você precisasse criar uma nova pasta com o nome de "Data". 

Divirta-se

Option Explicit

Option Explicit

Sub merge_multiple_workbooks()

Dim fldpath

Dim fld, fil, FSO As Object

Dim WKB As Workbook

Dim wks As Worksheet

Dim j As Long, w As Long

Dim stcol As String, lastcol As String

stcol = "A" ' Change the starting column of ur data

lastcol = "C" ' Change the ending column of ur data

' SHOW FOLDER DAILOG BOX

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "Choose the folder"

'.InitialFileName = "c:\"

.Show

End With

On Error Resume Next

fldpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"

If fldpath = False Then

MsgBox "Folder Not Selected"

Exit Sub

End If

' change sheet names here

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Application.Calculation = xlCalculationManual

Application.StatusBar = True

Application.StatusBar = "Please wait till Macro merge all the files"

Set FSO = CreateObject("scripting.filesystemobject")

Set fld = FSO.getfolder(fldpath)

' browse through all files in source folder

For Each fil In fld.Files

If UCase(Right(fil.Path, 5)) = UCase(".xlsx") And fil.Name <> ThisWorkbook.Name Then

Set WKB = Workbooks.Open(fil.Path)

For Each wks In WKB.Sheets

w = wks.Range("a65356").End(xlUp).Row

' stcol - starting column of my range eg - a

'2 - as my data will start from row 2 because i do not want to copy headers again and again

'lastcol - end column of range eg - c

' w - last filled row in sheet/ ending row of my data

If w >= 2 Then

wks.Range(stcol & "2:" & lastcol & w).Copy _

Destination:=ThisWorkbook.Sheets(1).Range("a65356").End(xlUp).Offset(1, 0)

End If

Next

WKB.Close

End If

Next

MsgBox "Done"

Application.StatusBar = False

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub


Reference

Tags: VBA, Excel, Tips, folder, pasta, diretório, subdiretório, Get, sub folder, names

Inline image 1

eBooks VBA na AMAZOM.com.br

LinkWithinBrazilVBAExcelSpecialist

Related Posts Plugin for WordPress, Blogger...

Vitrine