сПНЙ 10.

рЕЛЮ: еЫЕ ПЮГ Н ЯНЯРЮБКЕМХХ АЮГШ ДЮММШУ

жЕКЭ СПНЙЮ

б ПЮГПЮАЮРШБЮЕЛНЛ Б ДЮММНЛ СПНЙЕ ОПХКНФЕМХХ ЯНГДЮЕРЯЪ АЮГЮ ДЮММШУ РСПХЯРХВЕЯЙНИ ТХПЛШ "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ" МЮ ПЮАНВЕЛ КХЯРЕ Я ОНКЭГНБЮРЕКЭЯЙХЛ ХМРЕПТЕИЯНЛ Х ЯПЕДЯРБЮЛХ ЮМЮКХГЮ, ОНХЯЙЮ Х НАПЮАНРЙХ ХМТНПЛЮЖХХ, УПЮМХЛНИ Б АЮГЕ ДЮММШУ. оПЕДСЯЛНРПЕМЮ ЮПУХБЮЖХЪ Х СДЮКЕМХЕ БШАПЮММШУ ГЮОХЯЕИ АЮГШ ДЮММШУ.

б ОПНЖЕЯЯЕ ПЮГПЮАНРЙХ ДЮММНЦН ОПХКНФЕМХЪ БШ МЮ ОПЮЙРХЙЕ НЯБНХРЕ:

оПЮЙРХЙЮ

б ЩРНЛ СПНЙЕ ЯРПНХРЯЪ ОПХКНФЕМХЕ Я ОНКЭГНБЮРЕКЭЯЙХЛ ХМРЕПТЕИЯНЛ ОН ГЮОНКМЕМХЧ Х НАПЮАНРЙЕ АЮГШ ДЮММШУ РСПХЯРХВЕЯЙНИ ТХПЛШ "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ". аЮГЮ ДЮММШУ ЯНЯРНХР ХГ ДБСУ ПЮАНВХУ КХЯРНБ: аЮГЮдЮММШУ (ПХЯ. с 10.1) Х юПУХБ (ПХЯ. с10.2). йПНЛЕ РНЦН, ОПХ ОНЯРПНЕМХХ ЯБНДМНИ РЮАКХЖШ ОН АЮГЕ ДЮММШУ ЯНГДЮЕРЯЪ ПЮАНВХИ КХЯР ЯБНДМЮЪрЮАКХЖЮ.

пХЯ. с10.1. пЮАНВХИ КХЯР аЮГЮдЮММШУ

пХЯ. с10.2. пЮАНВХИ КХЯР юПУХБ

оНЯКЕ ГЮЦПСГЙХ ОПНЦПЮЛЛЮ ЯЮЛЮ АСДЕР ЯНГДЮБЮРЭ ЯБНИ ХМРЕПТЕИЯ, НРНАПЮФЮРЭ МЮГБЮМХЕ НЙМЮ ОПХКНФЕМХЪ Х ЕЯКХ МЮ ПЮАНВХУ КХЯРЮУ МЕР ГЮЦНКНБЙНБ ОНКЕИ, РН ЯНГДЮБЮРЭ ХУ. хМРЕПТЕИЯ ОПНЦПЮЛЛШ АСДЕР ЯНЯРНЪРЭ ХГ МЕЯЙНКЭЙХУ ДХЮКНЦНБШУ НЙНМ.

дХЮКНЦНБНЕ НЙМН

мЮГМЮВЕМХЕ

тНПЛЮ

пЕЦХЯРПЮЖХЪ РСПХЯРНБ ТХПЛШ "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ" (ПХЯ. с10.3)

дКЪ ГЮОНКМЕМХЪ ПЮАНВЕЦН КХЯРЮ аЮГЮдЮМ-МШУ

UserForm1

оНХЯЙ (ПХЯ. с10.4)

оПНХГБНДХР ОНХЯЙ ЙКХЕМРЮ ОН ТЮЛХКХХ. б ТЮЛХКХХ ЙКХЕМРЮ ДНОСЯРХЛН ХЯОНКЭГНБЮРЭ ЯХЛБНК <*> БЛЕЯРН ЦПСООШ КЧАШУ ЯХЛБНКНБ, ЯХЛБНК <?> БЛЕЯРН КЧАНЦН НДМНЦН ЯХЛБНКЮ. б ПЕГСКЭРЮРЕ ОНХЯЙЮ, Б ЯКСВЮЕ НРЯСРЯРБХЪ ОНДУНДЪЫХУ ЙКХЕМРНБ БШДЮЕРЯЪ ЯННРБЕРЯРБСЧЫЕЕ ЯННАЫЕМХЕ. еЯКХ ОНДУНДЪЫХЕ ЙКХЕМРШ МЮИДЕМШ, Б ПЮЯЙПШБЮЧЫЕЛЯЪ ЯОХЯЙЕ БШБНДХРЯЪ ЯОХЯНЙ ХУ ТЮЛХКХИ Х ХЛЕМ. бШАПЮБ РПЕАСЕЛНЦН ЙКХЕМРЮ Х МЮФЮБ ЙМНОЙС пЕДЮЙРХПНБЮРЭ, ОНКЭГНБЮРЕКЭ ОЕПЕУНДХР Й ЩРЮОС ПЕДЮЙРХПНБЮМХЪ ХМТНПЛЮЖХХ Н ЙКХЕМРЕ

UserForm3

оЕПЕПЕЦХЯРПЮЖХЪ РСПХЯРНБ ТХПЛШ "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ" (ПХЯ. с1 0.5)

б МЕЦН ГЮЦПСФЮЕРЯЪ ХМТНПЛЮЖХЪ Н МЮИДЕММНЛ ЙКХЕМРЕ. дНОСЯРХЛН КЧАНЕ ПЕДЮЙРХПНБЮМХЕ ХМТНПЛЮЖХХ Я ОНЯКЕДСЧЫЕИ ГЮЛЕМНИ ЯРЮПНИ ХМТНПЛЮЖХХ Н ЙКХЕМРЕ МЮ МНБСЧ Б АЮГЕ ДЮММШУ. рЮЙФЕ БНГЛНФМЮ ГЮОХЯЭ ХМТНПЛЮЖХХ Б ЮПУХБ Х ЕЕ СДЮКЕМХЕ ХГ АЮГШ ДЮММШУ.

UserForm2

тХКЭРПЮЖХЪ (ПХЯ. с10.6)

б ГЮБХЯХЛНЯРХ НР БШАПЮММНЦН ОЕПЕЙКЧВЮРЕКЪ НРНАПЮФЮЕР РНКЭЙН НОКЮВЕММШЕ ХКХ РНКЭЙН МЕ НОКЮВЕММШЕ ОСРЕБЙХ.

UserForm4

 

пХЯ. с 10.3. дХЮКНЦНБНЕ НЙМН пЕЦХЯРПЮЖХЪ РСПХЯРНБ ТХПЛШ "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ"

пХЯ. с10.4. дХЮКНЦНБНЕ НЙМН оНХЯЙ

пХЯ. с10.5. дХЮКНЦНБНЕ НЙМН оЕПЕПЕЦХЯРПЮЖХЪ РСПХЯРНБ ТХПЛШ "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ"

пХЯ. с10.6. дХЮКНЦНБНЕ НЙМН тХКЭРПЮЖХЪ

оЕПЕИДЕЛ Й ПЮЯЯЛНРПЕМХЧ ЙМНОНЙ ОЮМЕКХ ХМЯРПСЛЕМРНБ ОНКЭГНБЮРЕКЭЯЙНЦН ЛЕМЧ.

йМНОЙЮ

мЮГМЮВЕМХЕ

пЕЦХЯРПЮЖХЪ

юЙРХБХГХПСЕР ДХЮКНЦНБНЕ НЙМН пЕЦХЯРПЮЖХЪ РСПХЯРНБ ТХПЛШ "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ"

оНХЯЙ Х ПЕДЮЙРХПНБЮМХЕ

юЙРХБХГХПСЕР ДХЮКНЦНБНЕ НЙМН оНХЯЙ

тХКЭРП Х ЕЦН НРЛЕМЮ

яНГДЮЕР Б ГЮЦНКНБЙЮУ ОНКЕИ АЮГШ ДЮММШУ ПЮЯЙПШБЮЧЫХЕЯЪ ЯОХЯЙХ ЯН ЯПЕДЯРБЮЛХ ТХКЭРПЮЖХХ ДЮММШУ. оНБРНПМНЕ МЮФЮРХЕ МЮ ЙМНОЙС СДЮКЪЕР ЩРХ ЯОХЯЙХ

тХКЭРПЮЖХЪ НОКЮВЕММШУ ОСРЕБНЙ

юЙРХБХГХПСЕР ДХЮКНЦНБНЕ НЙМН тХКЭРПЮЖХЪ

яНПРХПНБЙЮ

яНПРХПСЕР ДЮММШЕ Б ЮКТЮБХРМНЛ ОНПЪДЙЕ ОН МЮОПЮБКЕМХЪЛ РСПНБ

яБНДМЮЪ -РЮАКХЖЮ

яНГДЮЕР МЮ НРДЕКЭМНЛ ПЮАНВЕЛ КХЯРЕ ЯБНДМСЧ РЮАКХЖС, Б ЙНРНПНИ ОНДЯВХРШБЮЕР ЯСЛЛЮПМСЧ ОПНДНКФХРЕКЭМНЯРЭ НОКЮВЕММШУ Х МЕНОКЮВЕММШУ ОСРЕБНЙ ОН ЙЮФДНЛС ХГ МЮОПЮБКЕМХИ РСПНБ

b

яНУПЮМЪЕР ДЮММШЕ ОН ОПХМЖХОС ЙНЛЮМДШ яНУПЮМХРЭ (Save)

Ъ

яНУПЮМЪЕР ДЮММШЕ ОН ОПХМЖХОС ЙНЛЮМДШ яНУПЮМХРЭ ЙЮЙ (Save as)

б ОНКЭГНБЮРЕКЭЯЙНЛ ЛЕМЧ тЮИК ХЛЕЧРЯЪ РНКЭЙН РПХ ОСМЙРЮ: ЯНУПЮМХРЭ, ЯНУПЮМХРЭ ЙЮЙ х гЮЙПШРЭ.

оЕПЕИДЕЛ РЕОЕПЭ Й РЕЙЯРС ОПНЦПЮЛЛШ. б ЯБНЕИ ЯРПСЙРСПЕ НМЮ ХЛЕЕР МЕЯЙНКЭЙН ЛНДСКЕИ. оПНЮМЮКХГХПСЕЛ ПЮАНРС ЩРНИ ОПНЦПЮЛЛШ, ОНЯКЕДНБЮРЕКЭМН НАЯСДХБ ЙЮФДШИ ХГ ЕЕ ЛНДСКЕИ.

лНДСКЭ лНДСКЭ 1

нОХЯШБЮЧРЯЪ ОЕПЕЛЕММШЕ СПНБМЪ ОПНЕЙРЮ.

Option Explicit

Public яОХЯНЙмЮИДЕММШУ () As String

Public тЮЛХКХЪ As String

'

' оПХ ОНХЯЙЕ ЙКХЕМРЮ ОН ТЮЛХКХХ Б ЯННРБЕРЯРБХХ Я ХЯОНКЭГСЕЛШЛ Б ОПХКНФЕМХХ

' ЮКЦНПХРЛНЛ МЮ ДКХМС ТЮЛХКХХ МЕ МЮКЮЦЮЕРЯЪ НЦПЮМХВЕМХИ

'

Public хЛЪ As String * 20

Public оНК As String * 3

Public бШАПЮММШИрСП As String * 20

Public нОКЮВЕМН As String * 3

Public тНРН As String * 3

Public оЮЯОНПР As String * 3

Public яПНЙ As String * 3

Public мНЛЕПяРПНЙХ As Integer

Public мЮИДЕММЮЪгЮОХЯЭ As Integer

Public оПНДНКФХРЕКЭМНЯРЭ As Integer

лНДСКЭ

ThisWorkbook

яНГДЮЕРЯЪ ОНКЭГНБЮРЕКЭЯЙНЕ ЛЕМЧ Х ОЮМЕКХ ХМЯРПСЛЕМРНБ, Ю РЮЙФЕ ГЮЦНКНБНЙ НЙМЮ ОНКЭГНБЮРЕКЭЯЙНЦН ОПХКНФЕМХЪ. сЯРЮМЮБКХБЮЕРЯЪ ЯБЪГЭ ЛЕФДС ЙМНОЙЮЛХ ОНКЭГНБЮРЕКЭЯЙНИ ОЮМЕКХ ХМЯРПСЛЕМРНБ Х ОПНЖЕДСПЮЛХ ЛНДСКЪ, ЙНРНПШЕ ХМХЖХЮКХГХПСЧР ЯННРБЕРЯРБСЧЫХЕ ДХЮКНЦНБШЕ НЙМЮ ХКХ БШОНКМЪЧР СЙЮГЮММШЕ ДЕИЯРБХЪ. сЯРЮМЮБКХБЮЕРЯЪ ПЕФХЛ ПЮАНРШ, ОПХ ЙНРНПНЛ БЕЯЭ ОНКЭГНБЮРЕКЭЯЙХИ ХМРЕПТЕИЯ ОПЕЙПЮЫЮЕР ЯБНЕ ЯСЫЕЯРБНБЮМХЕ ОПХ ГЮЙПШРХХ ОПХКНФЕМХЪ. оПНЖЕДСПЮ workbook_WindowActivate ЯНГДЮЕР ОНКЭГНБЮРЕКЭЯЙХИ ХМРЕПТЕИЯ ОПХ ГЮЦПСГЙЕ ЙМХЦХ. оПНЖЕДСПЮ workbook windowDeactivate БНЯЯРЮМЮБКХБЮЕР ХМРЕПТЕИЯ, ХЯОНКЭГСЕЛШИ Б НЙМЕ ПЮАНВЕИ ЙМХЦХ Excel ОН СЛНКВЮМХЧ.

Private Sub Workbook_WindowActivate(ByVal Wn As Excel.Window)

'

' оПНЖЕДСПЮ ЯНГДЮМХЪ МНБНИ ОЮМЕКХ ХМЯРПСЛЕМРНБ Х МНБНЕ ЛЕМЧ ОПХ

' НРЙПШРХХ ПЮАНВЕИ ЙМХЦХ

'

' оПХ НРЙПШРХХ ПЮАНВЕИ ЙМХЦХ ОЮМЕКХ ХМЯРПСЛЕМРНБ тНПЛЮРХПНБЮМХЕ

' Х яРЮМДЮПРМЮЪ ЯЙПШБЮЧРЯЪ Х НРНАПЮФЮЕРЯЪ МНБШИ ГЮЦНКНБНЙ НЙМЮ ОПХКНФЕМХЪ

With Application

.Caption = "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ"

.DisplayAlerts = False

.CoirmandBars ("Formatting") .Visible = False

.ContmandBars ("Standard") .Visible = False

End With

'

' яНГДЮМХЕ МНБНИ ОЮМЕКХ ХМЯРПСЛЕМРНБ Я ХЛЕМЕЛ

' пЮАНВЮЪ ОЮМЕКЭ ХМЯРПСЛЕМРНБ, ЙНРНПЮЪ АСДЕР

' СДЮКЪРЭЯЪ ОПХ ГЮЙПШРХХ ОПХКНФЕМХЪ

'

With Application.CommandBars.Add(NЮmЕ:="пЮАНВЮЪ ОЮМЕКЭ ХМЯРПСЛЕМРНБ", Position:=msoBarTop, MenuBar:=False, Temporary:=True)

.Visible = True

With .Controls

'

' оЕПБЮЪ ЙМНОЙЮ

'

With .Add(Type:=msoContro!Button, Id:=l)

.Caption = "пЕЦХЯРПЮЖХЪ"

.TooltipText = "пЕЦХЯРПЮЖХЪ ЙКХЕМРНБ"

.Style = msoButtonCaption

.OnAction = "лНДСКЭ1.UserForml_Initialize"

End With

'

' бРНПЮЪ ЙМНОЙЮ

'

With .Add(Typef=msoControlButton, Id:=l)

.Caption = "оНХЯЙ Х ПЕДЮЙРХПНБЮМХЕ"

.TooltipText = "оНХЯЙ Х ПЕДЮЙРХПНБЮМХЕ"

.Style = msoButtonCaption

.OnAction = "лНДСКЭ1.UserForm3_Initialize"

End With

'

' рПЕРЭЪ ЙМНОЙЮ

'

With .Add(Type:=msoControlButton, Id:=l)

.Caption = "тХКЭРП Х ЕЦН НРЛЕМЮ"

.TooltipText = "сЯРЮМНБЙЮ Х ЯМЪРХЕ ТХКЭРПЮ"

.Style = msoButtonCaption

.OnAction = "лНДСКЭ1.юБРНТХКЭРП"

End With

'

' вЕРБЕПРЮЪ ЙМНОЙЮ

'

With .Add{Type:=msoControlButton, Id:=1)

.Caption = "тХКЭРПЮЖХЪ НОКЮВЕММШУ ОСРЕБНЙ"

.TooltipText = "нРНАПЮФЮЧРЯЪ РНКЭЙН НОКЮВЕММШЕ ОСРЕБЙХ"

.Style = msoButtonCaption

.OnAction = "лНДСКЭ1.UserForm4_Initialize"

End With

'

' оЪРЮЪ ЙМНОЙЮ

'

With .Add(Type:=msoControlButton, Id:=l)

.Caption = "яНПРХПНБЙЮ"

.TooltipText = "яНПРХПНБЙЮ ДЮММШУ"

.Style = msoButtonCaption

.OnAction = "лНДСКЭ1.яНПРХПНБЙЮ"

End With

End With

End With

'

' бРНПЮЪ ОЮМЕКЭ ХМЯРПСЛЕМРНБ Я ХЛЕМЕЛ яБНДМЮЪ РЮАКХЖЮ Х ТЮИКШ

'

With Application.CommandBars.Add(Name:="яБНДМЮЪ РЮАКХЖЮ Х ТЮИКШ", Position:=msoBarTop, MenuBar:=False, Temporary:=True)

.Visible = True

With .Controls

'

' оЕПБЮЪ ЙМНОЙЮ

'

With .Add(Type:=msoControlButton, Id:=l)

.Caption = "яБНДМЮЪ РЮАКХЖЮ"

.TooltipText = "оНЯРПНЕМХЕ ЯБНДМНИ РЮАКХЖШ"

.Style = msoButtonCaption

.OnAction = "лНДСКЭ1.яБНДМЮЪрЮАКХЖЮ"

End With

'

' бРНПЮЪ ЙМНОЙЮ

'

With .Add(Type:=msoControlButton, Id:=3)

.TooltipText = "яНУПЮМХРЭ"

.OnAction = "лНДСКЭ!.гЮОХЯЭ"

End With

With .Add(Type:=msoControlButton, Id:=1175)

.TooltipText = "яНУПЮМХРЭ ЙЮЙ"

.OnAction = "лНДСКЭ1.яНУПЮМХРЭйЮЙ"

End With

End With

End With

With Application.CommandBars.Add(Name:="лНЕлЕМЧ", MenuBar:=True, Temporary:=True)

.Visible = True

With .Controls

'

' яНГДЮМХЕ ЯРПНЙХ ЛЕМЧ тЮИК

With .Add(Type:=msoControlPopup)

.Caption = "&тЮИК" With .Controls

With .Add(Type:=msoControlButton)

.Caption = "яНУПЮМХРЭ"

.OnAction = "лНДСКЭ1.гЮОХЯЭ"

End With

With .Add(Type:=msoControlButton)

.Caption = "яНУПЮМХРЭ ЙЮЙ"

.OnAction = "лНДСКЭ1.яНУПЮМХРЭйЮЙ"

End With

With .Add(Type:=msoControlButton)

.Caption = "гЮЙПШРЭ"

.OnAction = "лНДСКЭ1.гЮЙПШРЭ"

End With

End With

End With

End With

End With

End Sub

'

Private Sub Workbook_WindowDeactivate(ByVal Wn As Excel.Window)

'

' оПНЖЕДСПЮ, НРНАПЮФЮЧЫЮЪ ОЮМЕКХ ХМЯРПСЛЕМРНБ тНПЛЮРХПНБЮМХЕ

' Х яРЮМДЮПРМЮЪ ОПХ ГЮЙПШРХХ ОПХКНФЕМХЪ

' йПНЛЕ РНЦН, НМЮ СЯРЮМЮБКХБЮЕР ГЮЦНКНБНЙ НЙМЮ ОПХКНФЕМХЪ, ХЯОНКЭГСЕЛШЕ

' ОН СЛНКВЮМХЧ

'

With Application

.CommandBars("Formatting").Visible = True

.CoiranandBars("Standard").Visible = True

.Caption = Empty

End With

End Sub

пЮМЕЕ ОПХ НОХЯЮМХХ ЛНДСКЭ1 АШКХ СЙЮГЮМШ ОЕПЕЛЕММШЕ СПНБМЪ ОПНЕЙРЮ, РЕОЕПЭ ПЮЯЯЛНРПХЛ МЕЯЙНКЭЙН ЕЦН ОПНЖЕДСП.

лНДСКЭ

лНДСКЭ1
  • оПНЖЕДСПЮ UserForm1_Initialize ХМХЖХЮКХГХПСЕР ДХЮКНЦНБНЕ НЙМН пЕЦХЯРПЮЖХЪ РСПХЯРНБ ТХПЛШ "я МЮЛХ МЕ ЯНЯЙСВХЬЭЯЪ". рЮЙФЕ ОПХ ОНЛНЫХ БШГНБЮ ОПНЖЕДСПШ ГЮЦНКНБНЙ-КХЯРЮ Б МЕИ ЯНГДЮЧРЯЪ ГЮЦНКНБЙХ ОНКЕИ АЮГШ ДЮММЭЦУ МЮ ПЮАНВЕЛ КХЯРЕ, Б ЯКСВЮЕ ХУ НРЯСРЯРБХЪ.
  • оПНЖЕДСПЮ UserForm3_Initialize ЮЙРХБХГХПСЕР ДХЮКНЦНБНЕ НЙМН оНХЯЙ.
  • оПНЖЕДСПЮ userForm4_Initialize ЮЙРХБХГХПСЕР ДХЮКНЦНБНЕ НЙМН тХКЭРПЮЖХЪ.
  • оПНЖЕДСПЮ ЯНПРХПНБЙЮ СОНПЪДНВХБЮЕР ДЮММШЕ ОН ДБСЛ ЙПХРЕПХЪЛ: ОЕПБНМЮВЮКЭМШИ ЙПХРЕПХИ МЮОПЮБКЕМХЕ РСПЮ, БРНПНЯРЕОЕММШИ ≈ НОКЮРЮ
  • оПНЖЕДСПЮ яБНДМЮЪРЮАКХЖЮ ЯНГДЮЕР ПЮАНВХИ КХЯР яБНДМЮЪ-РЮАКХЖЮ ЯН ЯБНДМНИ РЮАКХЖЕИ (ПХЯ. с10.7). яРНКАЖШ ЯБНДМНИ РЮАКХЖШ НЯМНБЮМШ МЮ ОНКЕ НОКЮВЕМН; ЯРПНЙХ ≈ МЮ ОНКЕ МЮОПЮБКЕМХЕ РСПЮ, Ю ПЕГСКЭРЮРШ ЯБНДМНИ РЮАКХЖШ ОНДБНДЪРЯЪ ЯСЛЛХПНБЮМХЕЛ ОН ОНКЧ оПНДНКФХРЕКЭМНЯРЭ АЮГШ ДЮММШУ. мЮ НЯМНБЕ ЯБНДМНИ РЮАКХЖШ ЯРПНХРЯЪ ДХЮЦПЮЛЛЮ. оПХ ЩРНЛ ХЯОНКЭГСЕРЯЪ ЯБНИЯРБН TableRangel НАЗЕЙРЮ PivotTable,
    БНГБПЮЫЮЧЫЕЕ ДХЮОЮГНМ Я ДЮММШЛХ ЯБНДМНИ РЮАКХЖШ, ВРН ОНГБНКЪЕР ХГАЕФЮРЭ МЕНАУНДХЛНЯРХ ЪБМНЦН НОХЯЮМХЪ ДХЮОЮГНМЮ, ОН ЙНРНПНЛС ЯРПНХРЯЪ ДХЮЦПЮЛЛЮ.
  • оПНЖЕДСПЮ ЯНУПЮМХРЭйЮЙ ЮЙРХБХГХПСЕР БЯРПНЕММНЕ ДХЮКНЦНБНЕ НЙМН яНУПЮМЕМХЕ ДНЙСЛЕМРЮ.
  • оПНЖЕДСПЮ ГЮЙПШРЭ ГЮЙПШБЮЕР ОПХКНФЕМХЕ.

пХЯ. с10.7. пЮАНВХИ КХЯР яБНДМЮЪрЮАКХЖЮ

Public Sub UserForml_Initialize()

'

' оПНЖЕДСПЮ ЮЙРХБХГЮЖХХ ДХЮКНЦНБНЦН НЙМЮ пЕЦХЯРПЮЖХЪ РСПХЯРНБ

' Х ГЮДЮМХЕ ЩКЕЛЕМРНБ ПЮЯЙПШБЮЧЫЕЦНЯЪ ЯОХЯЙЮ

'

'

' оПНБЕПЙЮ МЮКХВХЪ ГЮЦНКНБЙЮ АЮГШ ДЮММШУ.

' оНЯРПНЕМХЕ ГЮЦНКНБЙЮ АЮГШ ДЮММШУ Б ЯКСВЮЕ ЕЦН НРЯСРЯРБХЪ

If Sheets("аЮГЮдЮММШУ").Range("Al").Value <> "тЮЛХКХЪ" Then гЮЦНКНБНЙкХЯРЮ

End If

'

' гЮДЮМХЕ ЩКЕЛЕМРНБ ПЮЯЙПШБЮЧЫЕЦНЯЪ ЯОХЯЙЮ

'

With UserForml

.CommandButtonl.Default = True

.CommandButton2.Cancel = True

.ComboBoxl.List = Array("кНМДНМ", "оЮПХФ", "аЕПКХМ")

.ComboBoxl.Listlndex = 0

.OptionButtonl.Value = True

.SpinButtonl.Value = 1

.CheckBoxl.Value = False

.CheckBox2.Value = False

.CheckBox3.Value = False

End With

'

' юЙРХБХГЮЖХЪ ДХЮКНЦНБНЦН НЙМЮ

'

UserForml.Show

'

End Sub

Public Sub гЮЦНКНБНЙкХЯРЮ()

With Sheets("аЮГЮдЮММШУ")

.Range("Al").Value = "тЮЛХКХЪ"

.Range("Bl").Value = "хЛЪ"

.Range("Cl").Value = "оНК"

.Range("Dl").Value = "мЮОПЮБКЕМХЕ РСПЮ"

.Range("El").Value = "нОКЮВЕМН"

.Range("Fl").Value = "тНРН ЯДЮМШ"

.Range("Gl").Value = "оЮЯОНПР ЯДЮМ"

.Range("HI").Value = "оПНДНКФХРЕКЭМНЯРЭ"

.Range("A:A").ColumnWidth = 9.43

.Range ("B:C") .ColuimWidth = 8.43

.Range("D:D").ColumnWidth = 13.43

.Range'("E:E") .ColumnWidth = 10.14

.Range("F:F").ColumnWidth = 9

.Range("G:G").ColumnWidth = 8.43

.Range("H:H").ColumnWidth = 19.14

End With

'

Sheets("аЮГЮдЮММШУ").Rows("1:1")

.Select With Selection

.Font.Bold = True

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlTop

.WrapText = True With .Interior

.Colorlndex = 36

.Pattern = xlSolid

End With

End With

Sheets("аЮГЮдЮММШУ").Rows("2:2")

.Select ActiveWindow.FreezePanes = True

End Sub

'

Public Sub гЮОХЯЭ ()

ActiveWorkbook.Save

End Sub '

Private Sub UserForm3_Initialize()

'

' оПНЖЕДСПЮ ЮЙРХБХГЮЖХХ ДХЮКНЦНБНЦН НЙМЮ оНХЯЙ

'

UserFormS.Show End Sub

Private Sub юБРНТХКЭРП()

' оПНЖЕДСПЮ БШГНБЮ ЙНЛЮМДШ юБРНТХКЭРП

'

Sheets("аЮГЮдЮММШУ").Range("A1:H1").Select Selection.AutoFilter

End Sub

Private Sub UserForm4_Initialize()

'

' оПНЖЕДСПЮ ЮЙРХБХГЮЖХХ ДХЮКНЦНБНЦН НЙМЮ ТХКЭРПЮЖХХ

'

With UserForm4

.OptionButtonl.Value = True

.Show End With End Sub

'

Private Sub яНПРХПНБЙЮ()

'

' оПНЖЕДСПЮ ЯНПРХПНБЙХ ДЮММШУ

' оЕПБНМЮВЮКЭМШИ ЙПХРЕПХИ ЯНПРХПНБЙХ - МЮОПЮБКЕМХЕ РСПЮ,

' БРНПНЯРЕОЕММШИ - ОПНХГБЕДЕМХЕ НОКЮРШ

Dim n юs Integer '

' n - БЯОНЛНЦЮРЕКЭМЮЪ ОЕПЕЛЕММЮЪ '

Sheets("аЮГЮдЮММШУ").Range("A2").Select

n = Selection. CurrentRegion. Rows. Count '

' нОПЕДЕКЕМХЕ ВХЯКЮ ГЮОХЯЕИ Б АЮГЕ ДЮММШУ

'

Worksheets("аЮГЮдЮММШУ").Range(Cells(2, 1),

Cells(n + 1, 8))

.Sort keyl≈Worksheets("аЮГЮдЮММШУ")

.Range("D2"), orderl:=xlAscending,

key2:=Worksheets("аЮГЮдЮММШУ").Range("E2")," _

order2:=xlDescending

'

' яНПРХПНБЙЮ ОН РСПЮЛ Б БНГПЮЯРЮЧЫЕЛ,

' Ю ОН НОКЮРЕ - Б САШБЮЧЫЕЛ ОНПЪДЙЕ

'

End Sub

Private Sub яБНДМЮЪрЮАКХЖЮ ()

'

' оПНЖЕДСПЮ ОНЯРПНЕМХЪ ЯБНДМНИ РЮАКХЖШ

'

Dim n As Integer

'

'

Dim яОХЯЙХ, мЮГМЮВЕМХЕ As String

Dim кХЯР As Object

Dim хЛЪйМХЦХ As String

хЛЪйМХЦХ = ActiveWorkbook.Name

'

' хЯЙКЧВЮЕЛ ПЮЯЬХПЕМХЕ ХГ ХЛЕМХ ЙМХЦХ '

For i = 1 рН Len(хЛЪйМХЦХ)

If Mid(хЛЪйМХЦХ, i, 1) = "." Then

хЛЪйМХЦХ = Mid(хЛЪйМХЦХ, 1, i - 1)

Exit For

End If

Next i

хЛЪйМХЦХ = Trim(хЛЪйМХЦХ)

' сДЮКЪЧРЯЪ ПЮМЕЕ ЯНГДЮММШЕ ПЮАНВХЕ КХЯРШ Я ХЛЕМЕЛ .яБНДМЮЪрЮАКХЖЮ

For Each Лист In Worksheets

If Лист.Name = "СводнаяТаблица" Then Sheets("СводнаяТаблица").Delete

End If

Next Лист

' Создается новый рабочий лист с именем СводнаяТаблица

'

Worksheets.Add

ActiveSheet.Name = "СводнаяТаблица"

n = Worksheets("БазаДанных").Range("A2")

.CurrentRegion.Rows.Count

'

'

' Определение диапазона, по которому будет строиться

' сводная таблица (Списки) и

где она будет расположена (Назначение).

' Эти диапазоны записываются в виде строковых выражений

Списки = "БазаДанных!R1C1:R" & CStr(n) & "С8"

Назначение = "[" & ИмяКниги & "]СводнаяТаблица!R1C1"

'

' Создание сводной таблицы '

ActiveSheet.PivotTableWizard

SourceType:=xlDatabase,

SourceData:=Cписки,

TableDestination:=Hазвание, ТаblеNаmе:="Отчет"

ActiveSheet.PivotTables("Отчет").AddFields

RowFields:="Направление тура", ColumnFields:="Оплачено"

With ActiveSheet.PivotTables("Отчет")

.PivotFields("Продолжительность")

.Orientation = xlDataField

.Name = "Сумма по полю Продолжительность"

.Function = xlSum End With

'

' Построение диаграммы по сводной таблице

'

Dim СводнаяТаблица As PivotTable

Dim Диапазон As Range

Set СводнаяТаблица = ActiveSheet.PivotTables("Отчет")

With ActiveSheet.PivotTables("Отчет")

'

' He отображаются итоги по строкам и столбцам

'

.RowGrand = False .ColumnGrand = False

End With

'

' Определение диапазона из сводной таблицы,

' по которому строится диаграмма

'

Set Диапазон = ActiveSheet.PivotTables("Отчет").TableRangel

'

' Построение диаграммы

'

Charts.Add

ActiveChart.ChartType = xlColumnClustered

ActiveChart.SetSourceData Source:=Диапазон,

PlotBy:=xlColumns

ActiveChart.Location Where:=xlLocationAsObject,

Name:="СводнаяТаблица"

With ActiveChart

.HasTitle = False

.Axes(xlCategory, xlPrimary).HasTitle = False

.Axes(xlValue, xlPrimary).HasTitle = True

.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = _

"Продолжительность оплаченных/неоплаченных поездок"

End With

'

End Sub

'

Sub СохранитьКак()

'

' Процедура активизирует встроенное окно Сохранение документа

'

Application.Dialogs(xlDialogSaveAs).Show

End Sub

'

Sub Закрыть()

'

' Процедура закрытия приложения

'

Application,Quit

End Sub

Модуль

UserForml

Программа считывает информацию с диалогового окна Регистрация туристов фирмы "С нами не соскучишься" (рис. У 10.3) и обеспечивает ввод набранных в нем данных в рабочий лист БазаДанных.

  • Нажатие кнопки ок активизирует процедуру CommandButton1_Click по считыванию информации с диалогового окна и заполнению базы данных.
  • Счетчик активизирует процедуру SpinButton1_Change, которая вводит значения счетчика в поле продолжительность тура.
  • Процедура TextBox3_Change синхронизирует вводимые данные в поле продолжительность тура со значением счетчика.
  • Нажатие кнопки Отмена активизирует процедуру CommandButton2_Сlick, которая закрывает диалоговоеокно Регистрация туристов фирмы "С нами не соскучишься" .


Private Sub CommandButtonl_Click()

' В переменную НомерСтроки вводится номер первой пустой строки

' рабочего листа БазаДанных

НомерСтроки = Application.CountA(Sheets("БазаДанных").Range("A:A")) + I

'

' Считывание информации в переменные из диалогового окна

With UserForml

Фамилия = .TextBoxl.Text Имя = .TextBox2.Text

Продолжительность = .TextBox3.Text

If .OptionButtonl.Value = True Then

Пол = "Муж"

Else

Пол = "Жен"

End If

If ..CheckBoxl.Value = True Then

Оплачено = "Да"

Else

Оплачено = "Нет"

End If

If .CheckBox2.Value = True Then

Фото'= "Да"

Else

Фото = "Нет"

End If

If .CheckBoxS = xlOn Then

Паспорт = "Да"

Else

Паспорт = "Нет"

End If

ВыбранныйТур = .ComboBoxl.Text

End With

'

' Запись данных на рабочий лист БазаДанных

'

With Sheets("БазаДанных")

.Cells(НомерСтроки, 1).Value = Фамилия

.Cells(НомерСтроки, 2).Value = Имя

.Cells(НомерСтроки, 3).Value = Пол

.Cells(НомерСтроки, 4).Value = ВыбранныйТур

.Cells(НомерСтроки, 5).Value = Оплачено

.Cells(НомерСтроки, 6).Value = Фото

.Cells(НомерСтроки, 7).Value = Паспорт

.Cells(НомерСтроки, 8).Value = Продолжительность

End With

End Sub

'

Private Sub CommandButton2_Click()

'

' Процедура закрытия диалогового окна UserForml.Hide

End Sub

Private Sub SpinButtonl_Change()

'

' Процедура .ввода числа со счетчика в поле ввода

'

With UserForml

.TextBoxS.Text = CStr(.SpinButtonl.Value)

End With

End Sub

Private Sub TextBox3_Change()

'

' Процедура установки значения счетчика из поля ввода

With UserForml

.SpinButtonl.Value = CInt(.TextBox3.Text)

End With

'

End Sub

Модуль

UserForm3

Программа ищет по фамилии, введенной в поле Фамилия диалогового окна поиск (рис. У10.4), подходящих клиентов в базе данных. Если такие имеются, то список вариантов найденных клиентов в базе данных с указанием фамилий, имен и номеров записей, отображается в раскрывающемся списке Найденные варианты. В противном случае выдается сообщение о неудачном поиске (рис. У10.8).

  • Нажатие кнопки поиск активизирует процедуру CommandButton1_Click, которая производит поиск клиентов и отображает список найденных вариантов.
  • Нажатие кнопки Редактировать активизирует процедуру CommandButton2_Click, которая закрывает диалоговое окно поиск и активизирует диалоговое окно перерегистрация туристов фирмы "С нами не соскучишься" (рис. У10.5), заполняя его информацией о выбранном клиенте.
  • Нажатие кнопки отмена активизирует процедуру CommandButton3_Click, которая закрывает диалоговое окно Поиск.

 

Рис. У10.8. Сообщение о неудачном поиске клиента

Private Sub CommandButtonl_Click()

' Процедура поиска клиента

'

'

Dim i As Integer

Dim j As Integer

Dim n As Integer

Dim Строка As Integer

'

' i ,j и n - вспомогательные переменные

' В переменной i перебираются номера строк из базы данных,

' начиная со второй и заканчивая последней непустой строкой,

' номер которой определен в переменной Строка.

' Переменная j выполняет роль счетчика,

' учитывающего текущее количество отобранных вариантов.

' Если отобранных вариантов нет, то j присваивается 0.

' n присваивается конечному значению счетчика j

Dim Тест As String

'

' Тест - вспомогательная переменная, в которую вводится очередная

' проверяемая фамилия

'

Dim СписокНайденных() As String

Строка = Application.CountA(Sheets("БазаДанных").Columns(1)}

Фамилия = UserForm3.TextBoxl.Text

i = 2

j = 0

Do While i <= Строка

Тест = Sheets("БазаДанных").Cells (i, 1).Text

If IsNumeric(Application.Search(Фамилия, Тест)) = True Then

j = j + 1

End If

i = i + 1

Loop

If j = 0 Then

MsgBox "Вышла промашка. А клиента таково и в помине нет.",

vbExclamation, "Поиск" НайденнаяЗапись = 0

Exit Sub

End If

n = j

ReDim СписокНайденных(1 To n, 0 To 2) As String

' Двумерный динамический массив СписокНайденных используется для заполнения

' раскрывающегося списка с возможными вариантами клиентов.

' Первый и второй столбцы массива содержат фамилию и имя клиента,

' а третий - номера строки из рабочего листа БазаДанных,

' в которой записана информация о клиенте

'

'

i = 2

j = 0

Do While i <= Строка

Тест = Sheets("БазаДанных").Cells(i, 1).Text

If IsNumeric(Application.Search(Фамилия, Тест)) = True Then

j = j + 1

СписокНайденных(j, 0} = Тест

СписокНайденных(j, 1) = Sheets("БазаДанных").Cells(i, 2).Text

СписокНайденных(j , 2) = CStr(i)

End If

i = i + 1

Loop

'

' Заполнение раскрывающегося списка

'

With UserForm3.ComboBoxl

.Clear

.ColumnHeads = True

.ColumnCount = 3

.ColumnWidths = "60;60;10"

.List = СписокНайденных()

.Listlndex = 0

End With

' Ввод в переменную НайденнаяЗапись номера строки с

' первым клиентом, выведенным в раскрывающийся список

'

НайденнаяЗапись = CInt(СписокНайденных(1, 2))

End Sub

Private Sub CommandButton2_Click()

'

' Процедура закрытия диалогового окна Поиск,

' открытия диалогового окна Перерегистрация туристов

' и заполнением его информацией о найденном туристе

'

' Закрывается диалоговое окно Поиск

UserForm3.Hide

'

Dim n As Integer

'

' n - вспомогательная переменная, используемая для

' ввода из базы данных в раскрывающийся список

' направления тура найденного клиента

' (считывается из раскрывающегося списка

' номер строки выбранного клиента)

НайденнаяЗапись = UserForm3.ComboBoxl. List(UserForm3.ComboBoxl.Listlndex, 2)

' Если клиент не найден, то процедура информирует об этом,

' напоминая, что перед редактированием должен быть найден клиент

'

If НайденнаяЗапись = 0 Then

MsgBox "Сначала надо найти клиента", vblnformation, "Редактирование"

Exit Sub

End If

' Ввод из базы данных в диалоговое окно Редактирование

' информации о найденном клиенте

'

With UserForm2

.TextBoxl:Text = Sheets("БазаДанных")

.Cells(НайденнаяЗапись, 1)

.Value .TextBox2.Text = Sheets("БазаДанных")

.Cells(НайденнаяЗапись, 2).Value

.TextBox3.Text = Sheets("БазаДанных")

.Cells(НайденнаяЗапись, 8).Value

If Sheets("БазаДанных").Cells(НайденнаяЗапись, 3)

.Value = "Муж" Then

.OptionButtonl.Value = True

.OptionButton2.Value = False Else

.OptionButtonl.Value = False

.OptionButton2.Value = True End If If Sheets("БазаДанных")

.Cells(НайденнаяЗапись, 5)

.Value = "Да" Then

.CheckBoxl.Value = True Else

.CheckBoxl.Value = False

End If

If Sheets("БазаДанных").Cells(НайденнаяЗапись, 6)

.Value = "Да" Then

.CheckBox2.Value = True Else

.CheckBox2.Value = False

End If

If Sheets("БазаДанных").Cells(НайденнаяЗапись, 7)

.Value = "Да" Then

.CheckBox3.Value = True

Else

.CheckBox3.Value - False

End If

.ComboBoxl.List = Array("Афины", "Берлин", "Лондон")

ВыбранныйТур = Cells(НайденнаяЗапись, 4)

.Value Select Case ВыбранныйТур Case Is = "Афины"

n = 0 Case Is = "Берлин"

n = 1 Case Is = "Лондон"

n = 2

End Select

.ComboBoxl.Listlndex = n .Show

End With

'

End Sub '

Private Sub CortroandButton3_Click ()

'

' Процедура закрытия диалогового окна

'

UserForm3.Hide

End Sub

Модуль

UserForm2
  • Нажатие кнопки Запись в архив активизирует процедуру CommandButton1_Click, которая из диалогового окнаПеререгистрация туристов фирмы "С нами не соскучишься" (рис. У10.5) вводит данные на рабочий лист Архив.
  • Нажатие кнопки отмена активизирует процедуру ConmandButton2_Click, закрывающую диалоговое окно.
  • Нажатие кнопки Удалить активизирует процедуру CommandButton3_Click, которая удаляет запись из базы данных.
  • Нажатие кнопки Ввести изменения активизирует процедуру commandButton4 click, которая вводит внесенные : изменения в запись базы данных.

Private Sub CommandButtonl_Click()

'

' Процедура записи на рабочий лист Архив

Dim Строка As Integer '

' Строка - вспомогательная переменная, которой присваивается

' номер первой пустой строки рабочего листа Архив

' Копирование строки из рабочего листа БазаДанных в буфер обмена

'

Sheets("БазаДанных"}.Rows(НайденнаяЗапись).Сору

'

' Вставка в рабочий лист Архив содержания буфера обмена

'

With Sheets("Архив")

Строка-= Application.CountA(.Columns(1)) + 1

.Paste Destination:=.Rows(Строка)

End With

End Sub

Private Sub CommandButton2_Click()

' Закрытие диалогового окна Редактирование

UserForm2.Hide ' Обнуляется номер найденной записи

НайденнаяЗапись = 0

End Sub

Private Sub CommandButton3_Click()

'

' Процедура удаления строки из рабочего листа БазаДанных

НайденнаяЗапись = Sheets("БазаДанных").Cells(1, 20).Value

' Удаление записи

'

Sheets("БазаДанных").Rows(НайденнаяЗапись).Select

Selection.Delete

'

' Закрытие диалогового окна Редактирование

'

UserForm2.Hide '

' Обнуление переменной с номером строки

НайденнаяЗапись = 0

Sheets("БазаДанных").Cells(1, 20).Value = Empty

End Sub

Private Sub CommandButton4_Click()

'

' Процедура записи в базу данных измененной информации

'

' Считывание информации из диалогового окна "Редактирование"

' в переменные

With UserForm2

'

Фамилия = .TextBoxl.Text

Имя = .TextBox2.Text

Продолжительность = CInt(.TextBox3.Text)

If .OptionButtonl.Value = True Then

Пол = "Муж" Else

Пол = "Жен"

End If

If .CheckBoxl.Value = True Then

Оплачено = "Да" Else

Оплачено = "Нет"

End If

If .CheckBox2.Value = True Then

Фото = "Да"

Else

Фото = "Нет"

End If

If .CheckBoxS.Value = True Then

Паспорт = "Да"

Else

Паспорт = "Нет"

End If

ВыбранныйТур = .ComboBoxl.Text

End With

НайденнаяЗапись = Sheets("БазаДанных") .Cells (1, 20).Value '

' Запись редактируемой информации о клиенте в базу данных

With Sheetst"БазаДанных")

.Cells(НайденнаяЗапись, 1)

.Value = Фамилия

.Cells(НайденнаяЗапись, 2)

.Value = Имя

.Cells(НайденнаяЗапись, 3)

.Value = Пол

.Cells(НайденнаяЗапись, 4)

.Value = ВыбранныйТур

.Cells(НайденнаяЗапись, 5)

.Value = Оплачено

.Cells(НайденнаяЗапись, 6)

.Value = Фото

.Cells(НайденнаяЗапись, 7)

.Value = Паспорт

.Cells(НайденнаяЗапись, 8)

.Value = Продолжительность

End With

End Sub

Private Sub SpinButtonl_Change()

TextBox3.Text = CStr(SpinButtonl.Value)

End Sub

Модуль

UserForm4
  • Нажатие кнопки Фильтрация диалогового окна Фильтрация (рис. У10.6) активизирует процедуру CommandButton1_Click, которая производит фильтрацию данных из базы данных в зависимости от выбранного критерия фильтрации в группе Путевка .
  • Нажатие кнопки Отмена активизирует процедуру CommandButton2_Сlick, которая закрывает диалоговое окно Фильтрация.

Private Sub CommandButtonl_Click()

' Процедура фильтрации по критерию

Dim Flag As String

' Flag устанавливает критерий фильтрации по третьему столбцу

'

Sheets("БазаДанных").Rows(1).Select Selection.AutoFilter

With UserForm4

If .OptionButtonl.Value = True Then Flag = "Да"

If .OptionButton2.Value = True Then Flag = "Нет"

End With

'

' Считывание критерия из диалогового окна для фильтрации

Sheets("БазаДанных").Rows(l).Select Selection.AutoFilter

Selection.AutoFilter Field:=5, Criteria1:=Flag

'

' Фильтрация по критерию

'

End Sub

'

Private Sub CommandButton2_Click()

'

' Закрытие диалогового окна Фильтрация

'

UserForm4.Hide End Sub

Самостоятельное задание

Построить приложение, учитывающее движение товара на складе магазина "Все, чего душа пожелает". В диалоговом окне приема товара на склад (рис. У10.9) предусмотреть ввод наименования товара, цену, количество, дату приема и единицу измерения товара. Поступающие товары должны записываться в базу данных рабочего листа Склад.

Рис. У10.9. Диалоговое окно Все, чего душа пожелает. Прием товара.

Единицу измерения товара следует вводить при помощи раскрывающегося списка. Первоначально, в списке задать две единицы измерения: кг и штук. При появлении товара с новой единицей измерения, например литр, первый раз эта единица измерения вводится в раскрывающийся список вручную, после чего программа должна автоматически расширить список используемых единиц измерения, добавив в него введенную величину.

Рис. У10.10. Автоматическое расширение элементов раскрывающегося списка

Предусмотреть в приложении средства поиска товара. При продаже товара записывать информацию о проданном товаре в базу данных, хранящуюся на рабочем листе продано. При списании товара записывать информацию о нем в базу данных, хранящуюся на рабочем листе Списание. Обеспечить программную фильтрацию, сортировку данных и построение обобщающих сводных таблиц как по проданным, так и по списанным и находящимся еще на складе товарам.

Следующая процедура является примером того, как можно автоматически добавлять в раскрывающийся список новые элементы. В диапазон A1:А2 рабочего листа, на основе которого строится раскрывающийся список, введем кг и штук (рис. У10.10). При вводе в поле раскрывающегося списка нового элемента, отличного от предыдущих, и нажатии кнопки CommandButton1, этот элемент программно вводится в ячейку АЗ. Теперь раскрывающийся список автоматически будет строиться по диапазону A1 : АЗ и т. д.

Private Sub CommandButtonl_Click()

Dim Диапазон As String

'

' Диапазон, на основе которого строится поле со списком

'

Dim n, i As Integer

'

' n - число элементов в диапазоне

'

Dim Новый As String

'

' Новый - .элемент, вводимый в поле со списком

n = Application.CountAfRange("A:A"))

Новый = ComboBoxl.Text

'

' Проверка, совпадает ли элемент, вводимый в поле со списком,

' с каким-либо элементом списка. Если не совпадает, то

' он добавляется в конец диапазона, по которому строится список

'

If ComboBoxl.MatchFound = False Then

Cells(n + 1, .1).Value = Новый

Диапазон = "A1:A" & CStr(n + 1)

ComboBox1.RowSource = Диапазон

End If

End Sub

'

Private Sub UserForm_Initialize()

Dim Диапазон As String

Dim n As Integer

n = Application.CountA(Range("A:A"))

Диапазон = "A1:A" & CStr(n)

ComboBoxl.RowSource = Диапазон

UserForml.Show

End Sub