|
| | | |
 • I.4. Access - Raporty •
- 4.1 Dlaczego raport sam zmienia układ strony ?
- 4.2 Dlaczego nie działają raporty na innym komputerze ?
- 4.3 Jak zmienić tytuł etykiety gdy raport jest otwarty w trybie "podglądu", tak aby zmiany były bezpośrednio widoczne ?
- 4.4 Jak dopasować rozmiar raportu do okna (zmienić powiększenie) ?
- 4.5 Jak narysować prosty wykres słupkowy (nie jest potrzebna kontrolka MSGraph) ?
- 4.6 Jak narysować prosty wykres kołowy (nie jest potrzebna kontrolka MSGraph) ?
- 4.7 Jak wypełnić tło etykiety prostym wzorem ?
- 4.8 Jak rozpoznać podczas otwierania raportu, czy jest on otwierany w trybie
"Do wydruku" czy "Do podglądu" ?
- 4.9 Jak zrobić, aby wielkość czcionki automatycznie dopasowywała się do stałej wielkości pola etykiety w raporcie ?
- 4.10 Jak zrobić, by wysokość wszystkich pól w całym wierszu raportu była jednakowa ?
| | | | |
 |
| | |
|
4.1 Dlaczego raport sam zmienia układ strony ?
<cyt>
...... to udokumentowany Bug w Access 2000
Resetowanie ustawień marginesów jest powodowane przez włączoną
opcję Autokorekty nazw:
Narzędzia => Opcje => Ogólne => ramka: "Autokorekta nazw"
• Śledź informacje autokorekty nazw
• Wykonaj autokorektę nazw
Domyślnie A' 2k ma te kwadraciki zaznaczone.
Tymczasem rzecz jest bardzo użyteczna, ale jedynie na etapie projektowania.
Przed oddaniem użytkownikowi poodhaczaj, a marginesy przestaną wracać
do ustawień domyślnych
</cyt>
ΔΔΔ | | | | |
|
|
| | |
|
4.2 Dlaczego nie działają raporty na innym komputerze ?
Pytanie:
<cyt>
... po przeniesieniu bazy na komputer "docelowy" ... raporty nie wyświetlają się
ani w podglądzie, ani w widoku projektu.
Komunikatu nie pamiętam, ale chodzi o to, że komputer nie może
odnaleźć drukarki dla której tworzony był raport.
</cyt>
Odpowiedź:
<cyt>
Plik => Ustawienie strony => odznacz: Drukarka domyślna
Oczywiście raport w widoku projekt.
</cyt>
ΔΔΔ | | | | |
|
|
| | |
|
4.3 Jak zmienić tytuł etykiety gdy raport jest otwarty w trybie "podglądu", tak aby zmiany były bezpośrednio widoczne ?
Private Sub btnTest_Click()
Dim lbl As Access.Label
On Error Resume Next
' sprawdź, czy jest otwarty raport
If Reports("Report1").hwnd = 0 Then Exit Sub
Set lbl = Reports("Report1").lblTest
' sprawdź, czy istnieje etykieta
If lbl Is Nothing = True Then Exit Sub
With lbl
.Caption = "Ala ma Asa"
' wymuś odświeżenie etykiety
.Visible = False
.Visible = True
End With
Set lbl = Nothing
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.4 Jak dopasować rozmiar raportu do okna (zmienić powiększenie) ?
Private Sub btnTest_Click()
DoCmd.OpenReport "Report1", acViewPreview
DoCmd.SelectObject acReport, "Report1", False
DoCmd.RunCommand acCmdFitToWindow
' lub - zmień powiększenie
' DoCmd.RunCommand acCmdZoom150
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.5 Jak narysować prosty wykres słupkowy (nie jest potrzebna kontrolka MSGraph) ?
| Private Const MY_X As Long = 1200 | ' położenie pierwszego słupka |
| Private Const MY_WIDTH As Long = 300 | ' szerokość słupków |
| Private Const MY_MOVE As Long = 100 | ' odstęp między słupkami |
| Private Const MY_MOVE_LEFT As Long = 210 | ' przesunięcie układu w lewo w/m MY_X |
| Private Const MY_MIN_WIDTH As Long = 4 | ' minimalna szerokość rysowania |
| Private Const MY_BASE_LINE As Long = 4000 | ' dolna linia bazowa wykresu |
| Private Const MY_FLOW_HEIGHT As Long = 2000 | ' maksymalna wysokość słupka |
| Private Const MY_RANGE As Long = 1000 | ' względny zakres osi Y |
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim aValue(0 To 3) As Single
Dim aFillStyle(0 To 3) As Single
Dim aFillColor(0 To 3) As Single
' przeliczone wartości procentowe słupków;
' (warunek: 0 <= aValue(i) <= 1 )
aValue(0) = 0.999999
aValue(1) = 0.5
aValue(2) = 0.25
aValue(3) = 0.0000001
' styl wypełnienia
aFillStyle(0) = 4
aFillStyle(1) = 7
aFillStyle(2) = 6
aFillStyle(3) = 5
' kolor wypełnienie
aFillColor(0) = vbRed
aFillColor(1) = vbGreen
aFillColor(2) = vbBlue
aFillColor(3) = vbMagenta
zbDrawFlowChart aValue, aFillColor ', vbBlack ', aFillStyle
End Sub
Private Sub zbDrawFlowChart(arrValue() As Single, _
arrFillColor() As Single, _
Optional lColorRectBorder As Long = -1, _
Optional vFillStyle As Variant)
Dim snX1 As Single
Dim snX2 As Single
Dim snY1 As Single
Dim snY2 As Single
Dim snMarkerWidth As Single
Dim i As Long
snX2 = MY_X
snY2 = MY_BASE_LINE
' rysuj wykres
For i = 0 To UBound(arrValue)
Me.FillColor = arrFillColor(i)
If IsArray(vFillStyle) = True Then
Me.FillStyle = vFillStyle(i)
Else
Me.FillStyle = 0
End If
snX1 = snX2 + MY_MOVE
snX2 = snX2 + MY_WIDTH + MY_MOVE
snY1 = MY_BASE_LINE - MY_FLOW_HEIGHT * arrValue(i)
' nie rysuj dla zerowych wartości
If snY1 - snY2 <> 0 Then
If lColorRectBorder >= 0 Then
Me.Line (snX1, snY1)-(snX2, snY2), lColorRectBorder, B
Else
Me.Line (snX1, snY1)-(snX2, snY2), arrFillColor(i), B
End If
End If
Next
' rysuj układ współrzędnych:
' 1. oś Y
Me.Line (MY_X - MY_MOVE_LEFT, _
MY_BASE_LINE + MY_MIN_WIDTH)- _
(MY_X - MY_MOVE_LEFT + MY_MIN_WIDTH, _
MY_BASE_LINE - MY_FLOW_HEIGHT), _
vbBlack, B
' 2. znaczniki osi Y; - dwie jednostki szerokie,
' połówki węższe, ćwiartki wąskie
For i = (MY_RANGE / 8) To MY_RANGE Step (MY_RANGE / 8)
snMarkerWidth = -MY_MOVE_LEFT + 45 + _
(IIf((i Mod (MY_RANGE / 4)) = 0, 45, 0)) + _
(IIf((i Mod (MY_RANGE / 2)) = 0, 90, 0))
Me.Line (MY_X - MY_MOVE_LEFT, _
MY_BASE_LINE - MY_FLOW_HEIGHT * i / MY_RANGE)- _
(MY_X + snMarkerWidth, _
MY_BASE_LINE - MY_FLOW_HEIGHT * i / MY_RANGE + _
MY_MIN_WIDTH), vbBlack, B
Next
' 3. oś X
Me.Line (MY_X - MY_MOVE_LEFT, _
MY_BASE_LINE + MY_MIN_WIDTH)- _
(snX2 + MY_MOVE_LEFT, _
MY_BASE_LINE + MY_MIN_WIDTH + MY_MIN_WIDTH), _
vbBlack, B
' 4. ramka wykresu
Me.FillStyle = 1
Me.Line (MY_X - 2 * MY_MOVE_LEFT, _
MY_BASE_LINE + 1 * MY_MOVE_LEFT)- _
(snX2 + 2 * MY_MOVE_LEFT, _
MY_BASE_LINE - MY_FLOW_HEIGHT - MY_MOVE_LEFT), _
vbBlue, B
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.6 Jak narysować prosty wykres kołowy (nie jest potrzebna kontrolka MSGraph) ?
| Private Const MY_X As Long = 2000 | ' współrzędna X środka koła |
| Private Const MY_Y As Long = 2000 | ' współrzędna Y środka koła |
| Private Const MY_R As Long = 1800 | ' promień koła |
| Private Const MY_START As Single = -0.00000001 | ' kąt startowy pierwszego wycinka koła |
| Private Const MY_PI As Single = 3.14159265359 | ' liczba Pi |
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim aAngle(0 To 3) As Single
Dim aFillStyle(0 To 3) As Long
Dim aFillColor(0 To 3) As Long
' przeliczone wartości kątowe wycinków,
' warunek: Suma(aAngle(i) = 360 stopni
aAngle(0) = 45
aAngle(1) = 90
aAngle(2) = 110
aAngle(3) = 115
' styl wypełnienia
aFillStyle(0) = 4
aFillStyle(1) = 7
aFillStyle(2) = 6
aFillStyle(3) = 5
' kolor wypełnienie
aFillColor(0) = vbRed
aFillColor(1) = vbGreen
aFillColor(2) = vbBlue
aFillColor(3) = vbMagenta
zbDrawPieChart aAngle, aFillColor, vbBlack ', aFillStyle
End Sub
Private Sub zbDrawPieChart(arrAngle() As Single, _
arrFillColor() As Long, _
Optional lColorCircleBorder As Long = -1, _
Optional vFillStyle As Variant)
Dim snStart As Single
Dim snEnd As Single
Dim i As Long
' obrysuj koło
If lColorCircleBorder >= 0 Then
Me.Circle (MY_X, MY_Y), MY_R, lColorCircleBorder
End If
For i = 0 To UBound(arrAngle)
snEnd = snStart - arrAngle(i) * MY_PI / 180
Me.FillColor = arrFillColor(i)
' wypełnij wycinki wzorem
If IsArray(vFillStyle) = True Then
Me.FillStyle = vFillStyle(i)
Else
Me.FillStyle = 0
End If
' obrysuj wycinki
If lColorCircleBorder >= 0 Then
Me.Circle (MY_X, MY_Y), MY_R, lColorCircleBorder, _
snStart + MY_START, snEnd
Else
Me.Circle (MY_X, MY_Y), MY_R, arrFillColor(i), _
snStart + MY_START, snEnd
End If
snStart = snEnd - MY_START
Next
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.7 Jak wypełnić tło etykiety prostym wzorem ?
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
zbFillLabel Me.lblTest, vbYellow, vbRed, 7, 4
End Sub
Private Sub zbFillLabel(ctl As Access.Control, _
lColorBkg As Long, lFillColor As Long, _
lFillStyle As Long,lBorderWidth As Long)
With ctl
' narysuj prostokąt i przemaluj tło
Me.FillColor = lColorBkg
Me.FillStyle = 0
.BackStyle = 0
.BorderStyle = 0
Me.Line (.Left, .Top)-(.Left + .Width, .Top + .Height), , B
' wypełnij prostokąt wzorem
Me.DrawWidth = lBorderWidth
Me.FillStyle = lFillStyle
Me.FillColor = lFillColor
Me.Line (.Left, .Top)-(.Left + .Width, .Top + .Height), vbBlue, B
End With
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.8 Jak rozpoznać podczas otwierania raportu, czy jest on otwierany w trybie
"Do wydruku" czy "Do podglądu" ?
<cyt>
' Zauważyłem, że w Report_Open tryby wydruku lub podglądu różnią się atrybutem
' WS_DISABLED. Czyli daje się to wykryć np. za pomocą takiej procedury:
Private Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd&, ByVal nIndex&) As Long
Private Sub Report_Open(Cancel As Integer)
Dim lFlag As Long
Const WS_DISABLED = &H8000000
Const GWL_STYLE = -16
lFlag = GetWindowLongA(Me.hwnd, GWL_STYLE)
If (WS_DISABLED And lFlag) <> False Then
MsgBox "Wydruk"
Else
MsgBox "Podgląd"
End If
End Sub
</cyt>
' wiedząc dzięki Krzysztofowi już jak to zrobić, można spróbować uprościć procedurę:
Private Declare Function IsWindowEnabled Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Report_Open(Cancel As Integer)
If IsWindowEnabled(Me.hwnd) = 0 Then
MsgBox "Drukowanie raportu !"
Else
MsgBox "Podgląd raportu !"
End If
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.9 Jak zrobić, aby wielkość czcionki automatycznie dopasowywała się do stałej wielkości pola etykiety w raporcie ?
Pytanie:
<cyt>
Tworzę etykiety za pomocą raportu w Accessie 2003.
Jak zrobić aby wielkość czcionki automatycznie dopasowywała się do stałej wielkości pola etykiety ?
Ilość wpisywanych znaków max 20.
Chodzi o to, aby tekst zmieścił się w jednej linii z max. możliwą wielkością czcionki.
...
leku
</cyt>
Odpowiedź:
1. Raport pomocniczy
' Utwórz Raport pomocniczy rptTest, a na nim dwa formanty typu TextBox
' 1. formant Me.txtTest i ustaw mu CanShrink = True
' 2. formant Me.txtTestBis i ustaw mu CanShrink = False,
' Formant Me.txtTestBis jest potrzebny, dla przypadku gdy tekst jest krótki i należy powiększać czcionkę, a równocześnie wysokość etykiety jest na tyle duża, że pomieści ona dwa lub więcej wierszy.
' W module raportu umieść poniższy kod:
Public m_lHeight As Long
Public m_lHeightBis As Long
Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
m_lHeight = Me.txtTest.Height
m_lHeightBis = Me.txtTestBis.Height
End Sub
2. Raport roboczy
' Nie jest to metoda doskonała i uwzględniająca wszystkie przypadki.
' Przykład będzie poprawnie działał, gdy formant txtLabel będzie miał wysokość dopasowaną do wielkości czcionki (tzn. wysokość będzie dobrana do wysokości jednolinijkowego tekstu)
' Jest to metoda bardzo wolna, a dla dużej ilości rekordów wręcz "ślamazarna".
' Można ją przyspieszyć robiąc dodatkową tabelę zawierającą średnią długość tekstu (w znakach) i odpowiadającą takiemu tekstowi optymalną wielkość czcionki.
' W zdarzeniu Detail_Format należałoby pobrać długość ciągu znaków i dopasowywać wielkośc czcionki startując od odpowiadającej takiemu ciągowi znaków wielkości czcionki, aby zmniejszyć ilość wywołań zdarzenia Detail_Print w raporcie rptTest.
' W raporcie roboczym etykieta o stałej wielkości powinna posiadać nazwę "txtLabel"
Private m_lHeight As Long
Private m_lHeightBis As Long
Private m_lFontSize As Long
Private rpt As Access.Report
Private Sub Report_Open(Cancel As Integer)
m_lFontSize = Me.txtLabel.FontSize
DoCmd.OpenReport "rptTest", acViewPreview
Set rpt = Reports("rptTest")
With rpt
.Visible = False
' ustaw wielkość formantów na takie same
.txtTest.Height = Me.txtLabel.Height
.txtTest.Width = Me.txtLabel.Width
.txtTestBis.Height = Me.txtLabel.Height
.txtTestBis.Width = Me.txtLabel.Width
' i atrybuty czcionki
.txtTest.FontSize = m_lFontSize
.txtTest.FontName = Me.txtLabel.FontName
.txtTest.FontWeight = Me.txtLabel.FontWeight
.txtTest.FontItalic = Me.txtLabel.FontItalic
.txtTest.FontUnderline = Me.txtLabel.FontUnderline
.txtTest = "X"
.txtTestBis = "X"
' wymuś odświeżenie raportu
.txtTest.Visible = False
.txtTest.Visible = True
DoEvents
' pobierz wymiary pionowe, po wykonaniu
' się Detail_Print w "rptTest"
m_lHeight = .m_lHeight()
m_lHeightBis = .m_lHeightBis()
End With
End Sub
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim lHeightTmp As Long
With rpt
' przywróc wielkość czcionki
.txtTest.FontSize = m_lFontSize
' przypisz aktualny tekst
.txtTest = Me.txtLabel.Value
' wymuś odświeżenie raportu
.txtTest.Visible = False
.txtTest.Visible = True
DoEvents
' pobierz aktualną wysokość formantu w "rptTest"
lHeightTmp = .m_lHeight()
If lHeightTmp > m_lHeight Then
' za duży formant, zmniejszaj czcionkę
Do
.txtTest.FontSize = .txtTest.FontSize - 1
' wymuś odświeżenie raportu
.txtTest.Visible = False
.txtTest.Visible = True
DoEvents
' pobierz aktualną wysokość formantu
lHeightTmp = .m_lHeight
Loop Until lHeightTmp <= m_lHeight
Me.txtLabel.FontSize = .txtTest.FontSize
Else
' zwiększ o 1 pkt wielkość czcionki
.txtTest.FontSize = .txtTest.FontSize + 1
' wymuś odświeżenie raportu
.txtTest.Visible = False
.txtTest.Visible = True
DoEvents
' pobierz aktualną wysokość formantu
lHeightTmp = .m_lHeight
' sprawdź, jak wymiar pionowy się zmienił
If lHeightTmp > .m_lHeight Then
' nie rób nic, bo wysokość się zwiększyła
Else
Do
.txtTest.FontSize = .txtTest.FontSize + 1
' wymuś odświeżenie raportu
.txtTest.Visible = False
.txtTest.Visible = True
DoEvents
' pobierz aktualną wysokość formantu
lHeightTmp = .m_lHeight
Loop Until lHeightTmp > m_lHeightBis
Me.txtLabel.FontSize = .txtTest.FontSize - 1
End If
End If
End With
End Sub
Private Sub Report_Close()
On Error Resume Next
DoCmd.Close acReport, rpt.Name
Set rpt = Nothing
End Sub
ΔΔΔ | | | | |
|
|
| | |
|
4.10 Jak zrobić, by wysokość wszystkich pól w całym wierszu raportu była jednakowa ?
Pytanie zadał jarekopa:
<cyt>
Witam sredecznie, problem pewnie błahy, ale jednak...
Mam raport z podraportem, gdzie przeważnie będzie po kilka wierszy. Jedno z pól w rekordzie zawsze zawiera więcej danych, więc wysokość tej komórki powiększa się automatycznie, natomiast pozostałe komórki zawsze mieszczą się w jednej linii...
Moje pytanie, czy da się powiększać wszystkie komórki do wysokości najwyższej z nich... w tym przypadku zawsze do wysokości jednej z nich.
Na dokumencie końcowym jak te wysokości są różne, kiepsko to wygląda....(chodzi o budowanie równej tabelki)
</cyt>
Odpowiedź:
<cyt>
...... nie jest błahy :)
...... ustaw kontrolkom brak obramowania, pod nie wstaw poziomą linię.
Pionowe linie narysuj metodą Line.
Masz tu gotowca, dla sekcji " szczegóły".
Wklej do modułu raportu.
Function LiniePionowe()
Dim i As Integer, CRight As Integer, c As Control
For i = 0 To Me.Controls.Count - 1
Set c = Me.Controls(i)
With c
If c.Section = 0 Then
If .Left + .Width > CRight Then
CRight = .Left + .Width
End If
Me.Line (.Left, 0)-(.Left, 10000)
End If
End With
Next
Me.Line (CRight, 0)-(CRight, 10000)
End Function
Private Sub Szczegóły_Print(Cancel As Integer, PrintCount As Integer)
Call LiniePionowe
End Sub
ΔΔΔ | | | | |
|
| |
