Komolyabb funkciók használata esetén első lépés az engedélyeztetés (adatkapcsolatok használatánál is)
Alaphelyzet:
Referencia bővítése után:
Globális változók használata előnyös lehet:
' Globális változók :
Global conn As New ADODB.Connection
Global Cmd As New ADODB.Command
Global cmd1 As New ADODB.Command
Global rs, rs1 As Object
Global m_sql
Kis minta a formázások ki és bekapcsolásához:
Sub formazo()
'// Excel alkalmazás általános beállítása
Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"", False)" '// Müvelet gomsor terület kikapcsolása
Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"", True)" '// Müvelet gomsor terület bekapcsolása
Application.WindowState = xlMaximized '// státusz teljes
Application.DisplayFullScreen = True '// teljes képernyős üzemmód beállítása
Application.DisplayFullScreen = False '// teljes képernyős üzemmód kikapcsolása
Application.CutCopyMode = False '// Cellák nem másolhatóak
Application.ScreenUpdating = False '// képernyő friissítés kikapcsolása (gyorsitás)
Application.ScreenUpdating = True '// képernyő friissítés bekapcsolása
Application.DisplayFormulaBar = False '// képlet szerkesztő nem léthatósága kikapcsolása
Application.DisplayFormulaBar = True '// képlet szerkesztő nem léthatósága bekapcsolása
ActiveWindow.DisplayHeadings = False '// Fejléc láthatóság kikapcsolása
ActiveWindow.DisplayHeadings = False '// Fejléc láthatóság bekapcsolása
ActiveWindow.DisplayGridlines = False '// Gácsozat rajzolás kikapcsolása
ActiveWindow.DisplayGridlines = True '// Gácsozat rajzolás bekapcsolása
ActiveWindow.DisplayWorkbookTabs = False '// Munkapalok TABfülek kikapcsolása
ActiveWindow.DisplayWorkbookTabs = True '// Munkapalok TABfülek bekapcsolása
ActiveWindow.WindowState = xlMaximized '// képernyő meximalizásás bekapcsolása
Application.DisplayAlerts = False '// Hibaüzenetek képernyőre írásánek kikapcolása (gyorsitás)
Application.EnableCancelKey = xlDisabled '// Művelet visszavonás gomb tiltása
Application.Calculation = xlCalculationManual '// Képlet számolás manuális frissítés bekapcsolása
Application.Calculation = xlCalculationAutomatic '// Képlet számolás automatikus frissítés bekapcsolása
Application.EnableEvents = False '// Események figyelésének kikapcsolása (gyorsitás)
Worksheets("KL").DisplayPageBreaks = True '// laptörés engedélyezése
Worksheets("KL").Visible = xlVeryHidden '// munkalap elrejtése nagyon
Worksheets("KL").Visible = xlHidden '// munkalap elrejtése
Worksheets("KL").Visible = xlSheetVisible '// munkalap felfedése
Worksheets("KL").EnableOutlining = True '// Vonalzás bekapcsolása
Application.StatusBar = "Státusz sorba kiírás" '// Státusz sorba kiírás
Application.DisplayStatusBar = True '// Státusz sor láthatósá tétele
Application.DisplayStatusBar = False '// Státusz sor elrejtése
Application.DisplayStatusBar = True '// Státusz sor láthatósá tétele
'--- Munkalap (jelszavas védelem bekapcsolása és kikapcsolása)
ThisWorkbook.Worksheets("KL").Protect Password:="jelszo", DrawingObjects:=False, Contents:=True, Scenarios:=True, UserInterFaceOnly:=True '// munkalap Jelszóval zárolása/védelem bekapcsolása
ThisWorkbook.Worksheets("KL").Unprotect Password:="jelszo" '// munkalap Jelszóval zárolása/védelem kikapcolása
End Sub
Excel pivot forrása lehet egyből egy oracle adatbázis lekérdező select parancsa
Sub kl_sql_pivot()
' -- ORACLE adatkapcsolat SQL eredményét pivot táblába töltés és pivot szűrés beállitása
Dim PvtCache
Worksheets("pivote").Activate
' Képernyő frissítés ki (ezt érdemes külön eljárásba tenni)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'---- PRIVOT adat lekérdezése
m_UserID = "kl" 'Credentials(0)
m_PWD = "KLkl" 'Credentials(1)
m_conn = "Provider=OraOLEDB.Oracle.1;PwdChgDlg=0;Persist Security Info=True;User ID=" & m_UserID & ";Data Source=EDWT10;Password=" & m_PWD
m_connpivot = "OLEDB;Provider=OraOLEDB.Oracle.1;PwdChgDlg=0;Persist Security Info=True;User ID=" & m_UserID & ";Data Source=EDWT10;Password=" & m_PWD
Worksheets("pivote").PivotTables(1).ManualUpdate = False
Worksheets("pivote").PivotTables(1).PivotCache.EnableRefresh = True
Worksheets("pivote").PivotTables(1).PivotCache.CommandText = "select * from HN_EBH27091.CALENDAR where 1=1 and yyyy='2019' and MONTH_NUM = 2"
Worksheets("pivote").PivotTables(1).PivotCache.Connection = m_connpivot
Worksheets("pivote").PivotTables(1).PivotFields("IS_WEEKEND").CurrentPage = "N"
Worksheets("pivote").PivotTables(1).PivotCache.Refresh
' /// Pivot kapcsolat allaphelyzetbe állítésa
Worksheets("pivote").PivotTables(1).PivotCache.Connection = "OLEDB;Provider=OraOLEDB.Oracle.1"
Worksheets("pivote").PivotTables(1).PivotCache.CommandText = ""
Worksheets("pivote").PivotTables(1).ManualUpdate = True
Worksheets("pivote").PivotTables(1).PivotCache.EnableRefresh = False
' Képernyő frissítés be (ezt érdemes külön eljárásba tenni)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
' -- Oracle adatbázis SQL select eredményét a munkafüzetbe táblázatként betöltés is hasznos lehet és tartalom függő formázásokra is mintát adok (sajnos nagyon lassú tud lenni érdemesebb formázás nélkül betölteni majd területek kijelölése után csoportos formázással megvalósítani)
Sub kl_sql_tbl()
Dim LastCol
Dim ActRow
Worksheets("KL").Activate
' Képernyő frissítés ki
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A2:A2").Select
m_UserID = "kl" 'Credentials(0)
m_PWD = "KLkl" 'Credentials(1)
m_conn = "Provider=OraOLEDB.Oracle.1;PwdChgDlg=0;Persist Security Info=True;User ID=" & m_UserID & ";Data Source=EDWT10;Password=" & m_PWD
m_sql = "select * from HN_EBH27091.CALENDAR where 1=1 and yyyy='2019' and MONTH_NUM = 3"
conn.Open m_conn
Cmd.ActiveConnection = conn
Cmd.CommandType = adCmdText
' Set rs = Nothing
Cmd.CommandText = m_sql
Set rs = Cmd.Execute
LastCol = rs.Fields.Count - 1
' ---Fejléc kiírása
For x = 0 To LastCol
Cells(1, x + 1) = rs.Fields(x).Name
Next
' Mező tipus kiírása
For x = 0 To LastCol
Cells(2, x + 1) = rs.Fields(x).Type
Next
' felesleges lassú módszer, de az elvke megértéséhez jó
' Ciklus kiolvasásnál a típus eldöntése alapján formázás után kerül a munkala cellájába az egyes adat.
ActRow = 3
Do While Not rs.EOF
'ActRow = wbkNameRiport.Worksheets(1).ActiveCell.Row + 1
For Findex = 0 To LastCol
If rs.Fields(Findex).Type = 202 Or rs.Fields(Findex).Type = 130 Or rs.Fields(Findex).Type = 129 Or rs.Fields(Findex).Type = 200 Then 'TEXT
Cells(ActRow, Findex + 1).Select
Selection.NumberFormat = "@"
Selection.HorizontalAlignment = xlLeft
Selection.VerticalAlignment = xlCenter
If Cells(ActRow, 1) = "" Then
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
Else
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16770979
End With
End If
Cells(ActRow, Findex + 1).Value = rs.Fields(Findex).Value
End If
If rs.Fields(Findex).Type = 139 Then 'NUMBER
Cells(ActRow, Findex + 1).Select
Selection.NumberFormat = "#,##0"
Selection.HorizontalAlignment = xlRight
Selection.VerticalAlignment = xlCenter
If Cells(ActRow, 1) = "" Then
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
Else
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16770979
End With
End If
Cells(ActRow, Findex + 1).Value = rs.Fields(Findex).Value
End If
If rs.Fields(Findex).Type = 135 Then 'DATE
Cells(ActRow, Findex + 1).Select
Selection.NumberFormat = "m/d/yyyy"
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
If Cells(ActRow, 1) = "" Then
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
With Selection.Font
'.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.499984740745262
End With
Else
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16770979
End With
End If
Cells(ActRow, Findex + 1).Value = rs.Fields(Findex).Value
End If
Next Findex
ActRow = ActRow + 1
'ActRow = wbkNameRiport.Worksheets(1).Cells(Act + 2, StartCol).Row + 1
rs.MoveNext
Loop
Conn.Close
Set conn = Nothing
Set rs = Nothing
' Képernyő frissítés be
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Alaphelyzet:
Referencia bővítése után:
Excel objektumok használata:
Globális változók használata előnyös lehet:
' Globális változók :
Global conn As New ADODB.Connection
Global Cmd As New ADODB.Command
Global cmd1 As New ADODB.Command
Global rs, rs1 As Object
Global m_sql
Kis minta a formázások ki és bekapcsolásához:
Sub formazo()
'// Excel alkalmazás általános beállítása
Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"", False)" '// Müvelet gomsor terület kikapcsolása
Application.ExecuteExcel4Macro "Show.ToolBar(""Ribbon"", True)" '// Müvelet gomsor terület bekapcsolása
Application.WindowState = xlMaximized '// státusz teljes
Application.DisplayFullScreen = True '// teljes képernyős üzemmód beállítása
Application.DisplayFullScreen = False '// teljes képernyős üzemmód kikapcsolása
Application.CutCopyMode = False '// Cellák nem másolhatóak
Application.ScreenUpdating = False '// képernyő friissítés kikapcsolása (gyorsitás)
Application.ScreenUpdating = True '// képernyő friissítés bekapcsolása
Application.DisplayFormulaBar = False '// képlet szerkesztő nem léthatósága kikapcsolása
Application.DisplayFormulaBar = True '// képlet szerkesztő nem léthatósága bekapcsolása
ActiveWindow.DisplayHeadings = False '// Fejléc láthatóság kikapcsolása
ActiveWindow.DisplayHeadings = False '// Fejléc láthatóság bekapcsolása
ActiveWindow.DisplayGridlines = False '// Gácsozat rajzolás kikapcsolása
ActiveWindow.DisplayGridlines = True '// Gácsozat rajzolás bekapcsolása
ActiveWindow.DisplayWorkbookTabs = False '// Munkapalok TABfülek kikapcsolása
ActiveWindow.DisplayWorkbookTabs = True '// Munkapalok TABfülek bekapcsolása
ActiveWindow.WindowState = xlMaximized '// képernyő meximalizásás bekapcsolása
Application.DisplayAlerts = False '// Hibaüzenetek képernyőre írásánek kikapcolása (gyorsitás)
Application.EnableCancelKey = xlDisabled '// Művelet visszavonás gomb tiltása
Application.Calculation = xlCalculationManual '// Képlet számolás manuális frissítés bekapcsolása
Application.Calculation = xlCalculationAutomatic '// Képlet számolás automatikus frissítés bekapcsolása
Application.EnableEvents = False '// Események figyelésének kikapcsolása (gyorsitás)
Worksheets("KL").DisplayPageBreaks = True '// laptörés engedélyezése
Worksheets("KL").Visible = xlVeryHidden '// munkalap elrejtése nagyon
Worksheets("KL").Visible = xlHidden '// munkalap elrejtése
Worksheets("KL").Visible = xlSheetVisible '// munkalap felfedése
Worksheets("KL").EnableOutlining = True '// Vonalzás bekapcsolása
Application.StatusBar = "Státusz sorba kiírás" '// Státusz sorba kiírás
Application.DisplayStatusBar = True '// Státusz sor láthatósá tétele
Application.DisplayStatusBar = False '// Státusz sor elrejtése
Application.DisplayStatusBar = True '// Státusz sor láthatósá tétele
'--- Munkalap (jelszavas védelem bekapcsolása és kikapcsolása)
ThisWorkbook.Worksheets("KL").Protect Password:="jelszo", DrawingObjects:=False, Contents:=True, Scenarios:=True, UserInterFaceOnly:=True '// munkalap Jelszóval zárolása/védelem bekapcsolása
ThisWorkbook.Worksheets("KL").Unprotect Password:="jelszo" '// munkalap Jelszóval zárolása/védelem kikapcolása
End Sub
Excel pivot forrása lehet egyből egy oracle adatbázis lekérdező select parancsa
Sub kl_sql_pivot()
' -- ORACLE adatkapcsolat SQL eredményét pivot táblába töltés és pivot szűrés beállitása
Dim PvtCache
Worksheets("pivote").Activate
' Képernyő frissítés ki (ezt érdemes külön eljárásba tenni)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'---- PRIVOT adat lekérdezése
m_UserID = "kl" 'Credentials(0)
m_PWD = "KLkl" 'Credentials(1)
m_conn = "Provider=OraOLEDB.Oracle.1;PwdChgDlg=0;Persist Security Info=True;User ID=" & m_UserID & ";Data Source=EDWT10;Password=" & m_PWD
m_connpivot = "OLEDB;Provider=OraOLEDB.Oracle.1;PwdChgDlg=0;Persist Security Info=True;User ID=" & m_UserID & ";Data Source=EDWT10;Password=" & m_PWD
Worksheets("pivote").PivotTables(1).ManualUpdate = False
Worksheets("pivote").PivotTables(1).PivotCache.EnableRefresh = True
Worksheets("pivote").PivotTables(1).PivotCache.CommandText = "select * from HN_EBH27091.CALENDAR where 1=1 and yyyy='2019' and MONTH_NUM = 2"
Worksheets("pivote").PivotTables(1).PivotCache.Connection = m_connpivot
Worksheets("pivote").PivotTables(1).PivotFields("IS_WEEKEND").CurrentPage = "N"
Worksheets("pivote").PivotTables(1).PivotCache.Refresh
' /// Pivot kapcsolat allaphelyzetbe állítésa
Worksheets("pivote").PivotTables(1).PivotCache.Connection = "OLEDB;Provider=OraOLEDB.Oracle.1"
Worksheets("pivote").PivotTables(1).PivotCache.CommandText = ""
Worksheets("pivote").PivotTables(1).ManualUpdate = True
Worksheets("pivote").PivotTables(1).PivotCache.EnableRefresh = False
' Képernyő frissítés be (ezt érdemes külön eljárásba tenni)
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
' -- Oracle adatbázis SQL select eredményét a munkafüzetbe táblázatként betöltés is hasznos lehet és tartalom függő formázásokra is mintát adok (sajnos nagyon lassú tud lenni érdemesebb formázás nélkül betölteni majd területek kijelölése után csoportos formázással megvalósítani)
Sub kl_sql_tbl()
Dim LastCol
Dim ActRow
Worksheets("KL").Activate
' Képernyő frissítés ki
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A2:A2").Select
m_UserID = "kl" 'Credentials(0)
m_PWD = "KLkl" 'Credentials(1)
m_conn = "Provider=OraOLEDB.Oracle.1;PwdChgDlg=0;Persist Security Info=True;User ID=" & m_UserID & ";Data Source=EDWT10;Password=" & m_PWD
m_sql = "select * from HN_EBH27091.CALENDAR where 1=1 and yyyy='2019' and MONTH_NUM = 3"
conn.Open m_conn
Cmd.ActiveConnection = conn
Cmd.CommandType = adCmdText
' Set rs = Nothing
Cmd.CommandText = m_sql
Set rs = Cmd.Execute
LastCol = rs.Fields.Count - 1
' ---Fejléc kiírása
For x = 0 To LastCol
Cells(1, x + 1) = rs.Fields(x).Name
Next
' Mező tipus kiírása
For x = 0 To LastCol
Cells(2, x + 1) = rs.Fields(x).Type
Next
' felesleges lassú módszer, de az elvke megértéséhez jó
' Ciklus kiolvasásnál a típus eldöntése alapján formázás után kerül a munkala cellájába az egyes adat.
ActRow = 3
Do While Not rs.EOF
'ActRow = wbkNameRiport.Worksheets(1).ActiveCell.Row + 1
For Findex = 0 To LastCol
If rs.Fields(Findex).Type = 202 Or rs.Fields(Findex).Type = 130 Or rs.Fields(Findex).Type = 129 Or rs.Fields(Findex).Type = 200 Then 'TEXT
Cells(ActRow, Findex + 1).Select
Selection.NumberFormat = "@"
Selection.HorizontalAlignment = xlLeft
Selection.VerticalAlignment = xlCenter
If Cells(ActRow, 1) = "" Then
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
Else
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16770979
End With
End If
Cells(ActRow, Findex + 1).Value = rs.Fields(Findex).Value
End If
If rs.Fields(Findex).Type = 139 Then 'NUMBER
Cells(ActRow, Findex + 1).Select
Selection.NumberFormat = "#,##0"
Selection.HorizontalAlignment = xlRight
Selection.VerticalAlignment = xlCenter
If Cells(ActRow, 1) = "" Then
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
Else
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16770979
End With
End If
Cells(ActRow, Findex + 1).Value = rs.Fields(Findex).Value
End If
If rs.Fields(Findex).Type = 135 Then 'DATE
Cells(ActRow, Findex + 1).Select
Selection.NumberFormat = "m/d/yyyy"
Selection.HorizontalAlignment = xlCenter
Selection.VerticalAlignment = xlCenter
If Cells(ActRow, 1) = "" Then
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
With Selection.Font
'.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.499984740745262
End With
Else
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 1
.TintAndShade = -0.249946592608417
.Weight = xlHairline
End With
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 16770979
End With
End If
Cells(ActRow, Findex + 1).Value = rs.Fields(Findex).Value
End If
Next Findex
ActRow = ActRow + 1
'ActRow = wbkNameRiport.Worksheets(1).Cells(Act + 2, StartCol).Row + 1
rs.MoveNext
Loop
Conn.Close
Set conn = Nothing
Set rs = Nothing
' Képernyő frissítés be
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
XLSX Jelszó eltávolítása:
· Nyissuk meg a fájlt egy HEX editorral
· Keressük meg a "DPB" karakterláncot
· A "B" karaktert javítsuk "x"-re
· Mentsük el a fájlt
· Nyissuk meg Excel-ben
· A VBA hibaüzeneteketre nyomjunk OK-t
· ALT-F11 -gyel nyissuk meg a Visual Basic Project ablakot
· Tools menü / VBAProject Properties / Protection
· A jelszó mezőkbe írjunk be egy egyszerű jelszót, de ne tiltsuk le a jelszóvédelmet.
· Mentés, bezárás és megnyitás újra
· Ismét ALT-F11, Tools / VBAProject Properties / Protection
· Tiltsuk le a jelszavas védelmet
· Mentés
Megjegyzések
Megjegyzés küldése