powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Оценка размеров папок и каждодневный учёт изменений...
5 сообщений из 5, страница 1 из 1
Оценка размеров папок и каждодневный учёт изменений...
    #33772238
Pchel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Закралась какая то ошибка,не могу понять,какая...Смысл роги:Учёт размеров указанных папок.Учёт должен проходить раз в день и ихменения автоматически внесены в список(по числам)...Не хочет делать...

Код:Dim rs As New ADODB.Recordset
Dim rsF As New ADODB.Recordset
Dim fso As New FileSystemObject
Dim dr As String

Dim fsStri As String
Dim fsWidt As String
Dim fsType As String
Dim Pap As Folder
Dim nS As Double
Dim i As Integer
Dim Si As Long

Dim n0 As String 'НаимОтдела
Dim n1 As String
Dim strSql As String
Dim Mstr As String
Dim Wstr As String
Dim Tstr As String
Dim Da As Long
Dim nR As Integer

Private Sub Form_Load()

Mstr = fnMstr(30)
Wstr = fnWstr(30, "700")
Tstr = fnWstr(30, " ")
Call FillGrid
Call FilChart

End Sub

Private Sub FillGrid()

Screen.MousePointer = vbHourglass 'песочные часики

Me.fgSS.Visible = False
Me.fgSS.Clear

' 0 1 2 3
fsStri = " |^Номер|Отдел, папка" + Mstr
fsWidt = "255|700 |2100 " + Wstr
fsType = " | | " + Tstr

fgSS.Clear
rsF.Open "select * from Отделы order by Порядок;", cnMain, adOpenStatic, adLockOptimistic

Me.fgSS.FormatString = fsStri
Call FGfrm(Me.fgSS, fsWidt)

Me.fgSS.Rows = rsF.RecordCount + 1
aMem = rsF.RecordCount + 1

i = 1
With Me.fgSS

strSql = "select * from ОтделыРазмер"
rs.Open strSql, cnMain, adOpenDynamic, adLockOptimistic

Do Until rsF.EOF
' rs.AddNew
.Row = i
.col = 1

n0 = rsF!НаимОтдела
dr = rsF!Путь + n0 + "\"

Set Pap = fso.GetFolder(dr)

If IsNull(rsF!НомерОтдела) Then
.col = 1: .Text = ""
.col = 2: .Text = n0 + rsF!Примечание
Else
.col = 1: .Text = Left(n0, 2)
.col = 2: .Text = Mid(n0, 4) + rsF!Примечание
End If

i = i + 1
rsF.MoveNext
Loop

rs.Close

' .Row = i
' .col = 2
' .text = "ВСЕГО:": .CellFontBold = True

End With
rsF.Close

'заполнение по числам размерами папок

For i = 30 To 1 Step -1

Da = DateValue(VBA.Date) - i + 1
rsF.Open "select НаимОтдела from Отделы where Группа = 1 order by Порядок;", cnMain, adOpenStatic, adLockOptimistic

fgSS.Row = 0
Si = 0

Do Until rsF.EOF
fgSS.Row = fgSS.Row + 1
fgSS.col = 30 + 3 - i

n0 = rsF!НаимОтдела
strSql = "select * from ОтделыРазмер where DateVal=" & Trim(Str(Da)) & " and НаимОтд='" & n0 & "';"
rs.Open strSql, cnMain, adOpenStatic, adLockOptimistic
If rs.RecordCount > 0 Then
fgSS.Text = Format(Trim(Str(rs!Размер)), formatRub)
Si = Si + rs!Размер
End If
rs.Close

rsF.MoveNext
Loop

rsF.Close
Next i

fgSS.Row = 0
fgSS.col = 0
fgSS.Text = " "

Me.fgSS.Visible = True

Screen.MousePointer = vbDefault


End Sub

Sub FilChart()

With Me.MSChart1
.RowCount = fgSS.colS - 3
.ColumnCount = fgSS.Rows - 1
.ChartType = VtChChartType2dLine

.TitleText = "Размеры основных рабочих папок на FileServ в Gb"
.Title.Location.LocationType = VtChLocationTypeTop

For nR = 3 To fgSS.colS - 1
fgSS.Row = 0
fgSS.col = nR
.Row = nR - 2
.RowLabel = fgSS.Text

For nC = 1 To fgSS.Rows - 1
.Column = nC
fgSS.Row = nC
fgSS.col = nR
.Data = Val(SqlNumber(fgSS.Text)) / 1000
fgSS.col = 2
.ColumnLabel = fgSS.Text

Next nC
Next nR


End With


'MSChart1.Plot.SeriesCollection(nR - 2).Pen.Style = 2
'VtPenStyleDashed = 2
'VtPenStyleDitted = 6
'VtPenStyleSolid = 1
'VtPenStyleNull = 0

' сделаем массив цветов
Dim PenCol(20) As myColor
PenCol(0).R = 255: PenCol(0).g = 255: PenCol(0).b = 128
PenCol(1).R = 128: PenCol(1).g = 255: PenCol(1).b = 128
PenCol(2).R = 128: PenCol(2).g = 255: PenCol(2).b = 255
PenCol(3).R = 255: PenCol(3).g = 128: PenCol(3).b = 64
PenCol(4).R = 0: PenCol(4).g = 128: PenCol(4).b = 128
PenCol(5).R = 128: PenCol(5).g = 128: PenCol(5).b = 255
PenCol(6).R = 128: PenCol(6).g = 64: PenCol(6).b = 0
PenCol(7).R = 64: PenCol(7).g = 128: PenCol(7).b = 128
PenCol(8).R = 128: PenCol(8).g = 128: PenCol(8).b = 0
PenCol(9).R = 128: PenCol(9).g = 128: PenCol(9).b = 128
PenCol(10).R = 204: PenCol(10).g = 255: PenCol(10).b = 204
PenCol(11).R = 255: PenCol(11).g = 204: PenCol(11).b = 204
PenCol(12).R = 128: PenCol(12).g = 255: PenCol(12).b = 255
PenCol(13).R = 204: PenCol(13).g = 204: PenCol(13).b = 255
PenCol(14).R = 255: PenCol(14).g = 51: PenCol(14).b = 0
PenCol(15).R = 51: PenCol(15).g = 204: PenCol(15).b = 153
PenCol(16).R = 204: PenCol(16).g = 204: PenCol(16).b = 51
PenCol(17).R = 255: PenCol(17).g = 204: PenCol(17).b = 204
PenCol(18).R = 204: PenCol(18).g = 153: PenCol(18).b = 51
PenCol(19).R = 255: PenCol(19).g = 153: PenCol(19).b = 204

fgSS.col = 1

'fgSS.col = 0
' рисуем цвета

For nR = 1 To fgSS.Rows - 1
MSChart1.Plot.SeriesCollection(nR).Pen.VtColor.Set PenCol(nR - 1).R, PenCol(nR - 1).g, PenCol(nR - 1).b
MSChart1.Plot.SeriesCollection(nR).Pen.Style = 1
fgSS.Row = nR
fgSS.CellBackColor = RGB(MSChart1.Plot.SeriesCollection(nR).Pen.VtColor.Red, MSChart1.Plot.SeriesCollection(nR).Pen.VtColor.Green, MSChart1.Plot.SeriesCollection(nR).Pen.VtColor.Blue)

Next nR



End Sub

Private Sub MSChart1_Click()

End Sub

Private Sub График_Click()
Call FillGrid
Call FilChart

End Sub


Заранее благодарен.
...
Рейтинг: 0 / 0
Оценка размеров папок и каждодневный учёт изменений...
    #33772313
Melkiades
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Что значит не хочет делать? Какая именно ошибка возникает мы молжны угадать?
...
Рейтинг: 0 / 0
Оценка размеров папок и каждодневный учёт изменений...
    #33772363
Pchel
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Она не учитывает то,что должна.Может я что-то пропустил?
...
Рейтинг: 0 / 0
Оценка размеров папок и каждодневный учёт изменений...
    #33772420
Melkiades
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Очень доходчивое объяснение.
1. Не нашел, где у вас прои сходит запись в базу.
2. Какая у вас СУБД? Вы уверены, что она корректно работает с русскими наименованиями объектов?
3. И самое главное. Где у вас считается размер папок?
...
Рейтинг: 0 / 0
Оценка размеров папок и каждодневный учёт изменений...
    #33772446
marvan
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Смысл данного кода - отображение содержимого некой БД. Никакого 'учёта размеров указанных папок' здесь нет, т.к. нет кода, который определяет размер директории.
Что не работает в данном коде?
...
Рейтинг: 0 / 0
5 сообщений из 5, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Оценка размеров папок и каждодневный учёт изменений...
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]