Да промениш номерацията на цитатите в статия за 1 секунда

vba_scripting_nauchna_statiq

При писане на статия се наложи промяна на литературата и респективно – на номерацията на цитатите. Проблемът е, че само източниците в литературата са 23 броя, а в статията има още много повече цитати. За целта, с помощта на едно просто VBA скриптче за Word, в което описваме стар номер и нов номер, за 1 секунда се преномерират всички цитати в статията и списъкът с литература.

Какво прави скриптчето?
В нашия случай трябва да се променят така: [2] -> [1], [3] -> [2], [4] -> [3], [6] -> [4].
За целта скриптчето прави точно 2 конверсии, т.е.:
[2] -> [], [3] -> [], [4] -> [], [6] -> [].
Умишлено временният стринг е такъв, за да се редуцира вероятността да го има в текста към 0.
Втората конверсия е: [] -> [1], [] -> [2], [] -> [3], [] -> [4].
За да въведем скриптчето в Word, натискаме Alt + F11, след това Insert > Module.
Въвеждаме го там и го изпълняваме с F5.
Ииии – voilà! Имаме си нова номерация в литературата и обновени цитати в статията.

Това беше първата версия на литературата, като се наложи да се коригира последователността:

[1] Pavlova, N. & Marchev, D. Application of artificial intelligence in generation of stem tasks, KNOWLEDGE –International Journal, Vol.66.2, pp. 185-191. 2024

[2] Желязкова, М. STEM в контекста на компетентностния подход в образованието, Образование и технологии, Vol. 13, стр. 206-212. 2022
[3] Кожухаров, М. Въведение в изкуствения интелект, Тракийски университет, ДИПКУ. Стара Загора, 2025, ISBN 978-954-691-114-8
[4] Кожухарова, Д. От дигитална компетентност към дигитална креативност. Академично издателство, Тракийски университет. Стара Загора, 2020, ISBN 978-954-338-166-1

Новата последователност на литературата:

[2] Желязкова, М. STEM в контекста на компетентностния подход в образованието, Образование и технологии, Vol. 13, стр. 206-212. 2022
[3] Кожухаров, М. Въведение в изкуствения интелект, Тракийски университет, ДИПКУ. Стара Загора, 2025, ISBN 978-954-691-114-8
[4] Кожухарова, Д. От дигитална компетентност към дигитална креативност. Академично издателство, Тракийски университет. Стара Загора, 2020, ISBN 978-954-338-166-1
[6] Рашева-Мерджанова, Я. Трансформация на ключовите компетентности на съвременния учител в контекста на социалното взаимодействие. – Стратегии на образователната и научната политика. № 3, с. 243 – 253, 2010

След изпълнение на скриптчето:
[1] Желязкова, М. STEM в контекста на компетентностния подход в образованието, Образование и технологии, Vol. 13, стр. 206-212. 2022
[2] Кожухаров, М. Въведение в изкуствения интелект, Тракийски университет, ДИПКУ. Стара Загора, 2025, ISBN 978-954-691-114-8
[3] Кожухарова, Д. От дигитална компетентност към дигитална креативност. Академично издателство, Тракийски университет. Стара Загора, 2020, ISBN 978-954-338-166-1
[4] Рашева-Мерджанова, Я. Трансформация на ключовите компетентности на съвременния учител в контекста на социалното взаимодействие. – Стратегии на образователната и научната политика. № 3, с. 243 – 253, 2010

Ето го и скриптчето:
Sub MultiReplaceOptimized_Unique()

Dim pairs As Variant
Dim i As Long
Dim oldNum As String, newNum As String
Dim find1 As String, rep1 As String
Dim find2 As String, rep2 As String
Dim rng As Range

' Wywejdame w lqwata chast na masiwa stariq nomer, a w dqsnata nowiqt. Created by Martin Petrov and ChatGPT
pairs = Array( _
Array("2", "1"), _
Array("3", "2"), _
Array("4", "3"), _
Array("6", "4"), _
Array("7", "5"), _
Array("12", "6"), _
Array("9", "7"), _
Array("15", "8"), _
Array("8", "9"), _
Array("14", "10"), _
Array("16", "11"), _
Array("17", "12"), _
Array("10", "13"), _
Array("19", "14"), _
Array("18", "15"), _
Array("20", "16"), _
Array("1", "17"), _
Array("13", "18"), _
Array("11", "19"), _
Array("21", "20"), _
Array("22", "21"), _
Array("23", "22"), _
Array("24", "23") _
)

For i = LBound(pairs) To UBound(pairs)

oldNum = pairs(i)(0)
newNum = pairs(i)(1)

find1 = "[" & oldNum & "]"
rep1 = "[]"

Set rng = ActiveDocument.Content
With rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = find1
.Replacement.Text = rep1
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

Next i

For i = LBound(pairs) To UBound(pairs)

newNum = pairs(i)(1)

find2 = "[]"
rep2 = "[" & newNum & "]"

Set rng = ActiveDocument.Content
With rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = find2
.Replacement.Text = rep2
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With

Next i

MsgBox "MP Replacer v 1.0. Ready", vbInformation

End Sub

Изключителни благодарности на проф. д.н. Наталия Христова Павлова

VN:F [1.9.22_1171]
Rating: 0.0/5 (0 votes cast)
VN:F [1.9.22_1171]
Rating: 0 (from 0 votes)

Вашият коментар

Вашият email адрес няма да бъде публикуван Задължителните полета са отбелязани с *