Клубове Дир.бг
powered by diri.bg
търси в Клубове diri.bg Разширено търсене

Вход
Име
Парола

Клубове
Dir.bg
Взаимопомощ
Горещи теми
Компютри и Интернет
Контакти
Култура и изкуство
Мнения
Наука
Политика, Свят
Спорт
Техника
Градове
Религия и мистика
Фен клубове
Хоби, Развлечения
Общества
Я, архивите са живи
Клубове Дирене Регистрация Кой е тук Въпроси Списък Купувам / Продавам 02:56 03.10.23 
Клубове/ Компютри и Интернет / Електронни таблици Пълен преглед*
Информация за клуба
Тема Re: въпрос за VBA [re: ***]
Автор lRlKO (непознат )
Публикувано16.10.09 14:36  



Private db As Database
Private rs As Recordset
Private r As Long
Private MYNUM1 As String
Private MYNUM2 As String
Private prom1 As String
Private prom2 As String
Private prom3 As String
Private ws As Worksheets
Private kol1 As String
Private kol2 As String
Sub DAOFromExcelTo_model()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use


MYNUM1 = Application.InputBox("въведете номер оператор")

Set db = OpenDatabase("C:\Documents and Settings\dk-ikosh\My Documents\vik.mdb")
' open the database
Set rs = db.OpenRecordset("PRIZN_RAZH1", dbOpenTable)
firstws = "цени"
Set wb = ActiveWorkbook
wb.Worksheets(firstws).Activate

If Range("D" & 7).Text <> "#DIV/0!" Then

If Range("D" & 7).Text <> "" Then
MsgBox ("има цена доставка")
prom1 = 1
prom2 = 0
Call DOST_NEOB
Call PRIZN_RAZH
prom1 = 0
firstws = "цени"
Set wb = ActiveWorkbook
wb.Worksheets(firstws).Activate
End If
Else
MsgBox ("няма цена доставка")
End If

Sub DOST_NEOB()
firstws = "необходими приходи"
Set wb = ActiveWorkbook
wb.Worksheets(firstws).Activate
'Set db = OpenDatabase("C:\Documents and Settings\dk-ikosh\My Documents\vik.mdb")
' open the database
' Set rs = db.OpenRecordset("PRIZN_RAZH1", dbOpenTable)
With rs
.AddNew
If prom1 = 1 Then
.Fields("nomer") = MYNUM1
MYNUM2 = Application.InputBox("въведете подномер")

.Fields("pod_nom") = MYNUM2

r = 7
.Fields("neob_vazvr") = Range("D" & r).Text
r = r + 1
.Fields("neob_razh") = Range("D" & r).Text '

r = r + 1
.Fields("neob_prih") = Range("D" & r).Text
r = r + 1
.Fields("neob_voda_dost") = Range("D" & r).Text
End If
If prom2 = 1 Then

.Fields("nomer") = MYNUM1
MYNUM2 = Application.InputBox(vavedete nomer)
.Fields("pod_nom") = MYNUM2

r = 7
.Fields("neob_vazvr") = Range("E" & r).Text '
r = r + 1
.Fields("neob_razh") = Range("E" & r).Text
r = r + 1
.Fields("neob_prih") = Range("E" & r).Text
r = r + 2
.Fields("neob_otv_prech_voda") = Range("E" & r).Text
r = r + 1
.Fields("neob_voda_bitov") = Range("E" & r).Text
r = r + 1
.Fields("neob_voda_prom") = Range("E" & r).Text
r = r + 1
.Fields("neob_voda_st1") = Range("E" & r).Text
r = r + 1
.Fields("neob_voda_st2") = Range("E" & r).Text
r = r + 1
.Fields("neob_voda_st3") = Range("E" & r).Text

End If
.CancelUpdate
End With
End Sub
Sub PRIZN_RAZH()
firstws = "признати разходи"
Set wb = ActiveWorkbook
wb.Worksheets(firstws).Activate
r = 9 ' the start row in the worksheet
'Do While Len(Range("A" & r).Formula) >= 0
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox (lastrow)
lastrow = 26
'For r = 7 To lastrow
' repeat until first empty cell in column A

' add values to each field in the record
If prom1 = 1 Then
kol1 = "c"
kol2 = "d"
End If
If prom2 = 1 Then
kol1 = "E"
kol2 = "F"
End If
With rs
.AddNew
.Fields("r_ob_mat_baz") = Range(kol1 & r).Text
.Fields("r_ob_mat_progn") = Range(kol2 & r).Value

r = r + 1
.Fields("r_mat_baz") = Range(kol1 & r).Value
.Fields("r_mat_progn") = Range(kol2 & r).Value

r = r + 1
.Fields("r_obez_baz") = Range(kol1 & r).Value
.Fields("r_obez_progn") = Range(kol2 & r).Value

r = r + 1
.Fields("r_koag_baz") = Range(kol1 & r).Value
.Fields("r_koag_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_flog_baz") = Range(kol1 & r).Value
.Fields("r_flog_progn") = Range(kol2 & r).Value

r = r + 1
.Fields("r_ltk_baz") = Range(kol1 & r).Value
.Fields("r_ltk_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_elen_baz") = Range(kol1 & r).Value
.Fields("r_elen_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_gor_baz") = Range(kol1 & r).Value

.Fields("r_gor_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_gorte_baz") = Range(kol1 & r).Value
.Fields("r_gorte_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_gortr_baz") = Range(kol1 & r).Value
.Fields("r_gortr_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_voda_baz") = Range(kol1 & r).Value

.Fields("r_voda_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_vchu_baz") = Range(kol1 & r).Value
.Fields("r_vchu_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_vsob_baz") = Range(kol1 & r).Value

.Fields("r_vsob_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_robl_baz") = Range(kol1 & r).Value
.Fields("r_robl_progn") = Range(kol2 & r).Value

r = r + 1

.Fields("r_kanm_baz") = Range(kol1 & r).Value
.Fields("r_kanm_progn") = Range(kol2 & r).Value

r = r + 1
.Fields("r_drugi_baz") = Range(kol1 & r).Value
.Fields("r_drugi_progn") = Range(kol2 & r).Value
If MYNUM1 <> 7 Then
r = r + 3
Else
r = r + 12
End If
.Fields("r_vanob_baz") = Range(kol1 & r).Value
.Fields("r_vanob_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_zast_baz") = Range(kol1 & r).Value
.Fields("r_zast_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_drvk_baz") = Range(kol1 & r).Value
.Fields("r_drvk_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_dan_baz") = Range(kol1 & r).Value
.Fields("r_dan_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_mdan_baz") = Range(kol1 & r).Value
.Fields("r_mdan_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_regul_baz") = Range(kol1 & r).Value
.Fields("r_regul_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_vobect_baz") = Range(kol1 & r).Value
.Fields("r_vobect_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_sreda_baz") = Range(kol1 & r).Value
.Fields("r_sreda_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_zaust_baz") = Range(kol1 & r).Value
.Fields("r_zaust_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_naemi_baz") = Range(kol1 & r).Value
.Fields("r_naemi_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_sobus_baz") = Range(kol1 & r).Value
.Fields("r_sobus_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_transp_baz") = Range(kol1 & r).Value
.Fields("r_transp_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_otop_baz") = Range(kol1 & r).Value
.Fields("r_otop_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_publ_baz") = Range(kol1 & r).Value
.Fields("r_publ_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_kons_baz") = Range(kol1 & r).Value
.Fields("r_kons_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_urid_baz") = Range(kol1 & r).Value
.Fields("r_urid_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_chet_baz") = Range(kol1 & r).Value
.Fields("r_chet_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_tech_BAZ") = Range(kol1 & r).Value
.Fields("r_tech_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_drug_BAZ") = Range(kol1 & r).Value
.Fields("r_drug_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_ohrana_baz") = Range(kol1 & r).Value
.Fields("r_ohrana_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_inkas_baz") = Range(kol1 & r).Value
.Fields("r_inkas_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_sad_baz") = Range(kol1 & r).Value
.Fields("r_sad_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_drugi1_baz") = Range(kol1 & r).Value
.Fields("r_drugi1_progn") = Range(kol2 & r).Value

r = r + 3
.Fields("r_am_ob_baz") = Range(kol1 & r).Value
.Fields("r_am_ob_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_vazn_ob_baz") = Range(kol1 & r).Value
.Fields("r_vazn_ob_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_tr_baz") = Range(kol1 & r).Value
.Fields("r_tr_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_hon_baz") = Range(kol1 & r).Value
.Fields("r_hon_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_osig_ob_baz") = Range(kol1 & r).Value
.Fields("r_osig_ob_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_sosig_baz") = Range(kol1 & r).Value
.Fields("r_sosig_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_srazh_baz") = Range(kol1 & r).Value
.Fields("r_srazh_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_drrazh_ob_baz") = Range(kol1 & r).Value
.Fields("r_drrazh_ob_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_hrana_baz") = Range(kol1 & r).Value
.Fields("r_hrana_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_ohr_baz") = Range(kol1 & r).Value
.Fields("r_ohr_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_sl_karta_baz") = Range(kol1 & r).Value
.Fields("r_sl_karta_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_com_baz") = Range(kol1 & r).Value
.Fields("r_com_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_danizt_baz") = Range(kol1 & r).Value
.Fields("r_danizt_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_kval_baz") = Range(kol1 & r).Value
.Fields("r_kval_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_izps_baz") = Range(kol1 & r).Value
.Fields("r_izps_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_dr_dr_baz") = Range(kol1 & r).Value
.Fields("r_dr_dr_progn") = Range(kol2 & r).Value
r = r + 3
.Fields("r_rem_baz") = Range(kol1 & r).Value
.Fields("r_rem_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_obsto_baz") = Range(kol1 & r).Value
.Fields("r_obsto_progn") = Range(kol2 & r).Value
r = r + 1
.Fields("r_ob_pr_baz") = Range(kol1 & r).Value
.Fields("r_ob_pr_progn") = Range(kol2 & r).Value

.Update
Set wb = Nothing
End With
End sub
Зареждам данни от sheets те са около 10 и накрая правя .update
Като ги тествам данните се зареждат, но накрая остават последните при .update Как да ги съхраня за последния .update
Ето така минавам от sheet в друг sheet
firstws = "признати разходи"
Set wb = ActiveWorkbook
wb.Worksheets(firstws).Activate
Тези кодове са в отделна процедура, която извиквам с call
<P ID="edit"><FONT class="small"><EM>Редактирано от lRlKO на 16.10.09 14:40.</EM></FONT></P>

Редактирано от lRlKO на 16.10.09 15:17.



Цялата тема
ТемаАвторПубликувано
* въпрос за VBA lRlKO   16.10.09 09:39
. * Re: въпрос за VBA ***   16.10.09 13:39
. * Re: въпрос за VBA lRlKO   16.10.09 14:36
Клуб :  


Clubs.dir.bg е форум за дискусии. Dir.bg не носи отговорност за съдържанието и достоверността на публикуваните в дискусиите материали.

Никаква част от съдържанието на тази страница не може да бъде репродуцирана, записвана или предавана под каквато и да е форма или по какъвто и да е повод без писменото съгласие на Dir.bg
За Забележки, коментари и предложения ползвайте формата за Обратна връзка | Мобилна версия | Потребителско споразумение
© 2006-2023 Dir.bg Всички права запазени.