->http://www.visualbasic-archiv.de/

Private myExl As New Excel.Application

' Bsp: Excel-Arbeitsmappen öffnen und Inhalt
' der Zelle A1 in einer Textbox anzeigen
Private Sub OpenmyExcel(Byval sTabName As String)     
  ' Excel-Arbeitsmappe öffnen
  myExl.Workbooks.Open sTabName

  ' Tabelle1 auswählen
  myExl.ActiveWorkbook.Sheets("Tabelle1").Select

  ' Inhalt der Zelle A1 in eine Textbox ausgeben
  Text1.Text = myExl.Range("A1").Value
End Sub

->http://www.visualbasic-archiv.de/

Private DB As Database
Private Rs As RecordSet

Private Sub CompareTables()
  Dim DBName As String
  Dim SQL As String
  Dim qry As QueryTable

  DBName = ActiveWorkbook.Name

  Set DB = DBEngine.OpenDatabase(DBName, False, False, _
    "Excel 8.0;")

  SQL = "SELECT * FROM `Tabelle1$` INNER JOIN `Tabelle2$` ON " & _
    "`Tabelle1$`.Name = `Tabelle2$`.Familienname AND " & _
    "`Tabelle1$`.Vorname = `Tabelle2$`.Vorname"

  Set Rs = DB.OpenRecordSet(SQL)

  ActiveWorkBook.Sheets("Tabelle3").Select
  Set qry = ActiveSheet.QueryTables.Add(Rs, Range("A1"))
  qry.Refresh
End Sub

njuuz:
-anhang am ende mit namen, komentaren. vorne & hinten mit datum & zeit
-extra konfig

->http://www.richard-soft.at.tt/ (2 download)

Function Datei_Lesen(Datei As String) As String
  Dim DateiNR As Integer
  Dim tmp As String
  DateiNR = FreeFile

  Open Datei For Input As DateiNR

  Do While EOF(DateiNR) = False
    Line Input #DateiNR, tmp
    Datei_Lesen = Datei_Lesen + tmp & vbCrLf
  Loop
End Function

Function Datei_Schreiben(Datei As String, Text As String)
  DateiNR = FreeFile

  Open Datei For Append As DateiNR
  Print #DateiNR, Text
  Close

End Function

->http://www.visualbasic-archiv.de/forum/read.php?f=5&i=2462&t=2455

...
If MsgBox("Wollen Sie den markierten Eintrag wirklich löschen?", _
    vbExclamation + vbYesNo, "Löschen") = vbYes Then
...

 8.3.02

njuuz:
-wie 3d-darstellung gestalten (bemaßung)?
-100ter dateien, je eine verwaltung mit comments etc, eine verwaltung über alle
-3d-darsteellung als ring?? ->

Dim koord(1 To 2, 1 To 4) As Integer 'vorn: 1=x, 2=y
  ' x1---------------x2
  ' |                |
  ' x3--------------x4

Function viereck(color As Integer) 'rechte und linke kante senkrecht, x1 kleiner x2
  Dim j As Single
  Dim i As Integer
  
  o% = koord(2, 1) - koord(2, 2)
  u% = koord(2, 3) - koord(2, 4)
  dx% = Abs(koord(1, 2) - koord(1, 1))
  vor_o% = o% / Abs(o%)
  vor_u% = u% / Abs(u%)
  Print koord(1, 1); koord(1, 2)
  For i = koord(1, 1) To koord(1, 2) Step 15
    c% = i - koord(1, 1)
    Picture1.Line (i, koord(2, 1) - (c% / dx%) * o%)-(i, koord(2, 3) - (c% / dx%) * u%), QBColor(color)
  Next i%
End Function

11.3.2002 

Const pi = 3.14159265358979

function ellipse()
  For i% = 0 To 31
    Picture1.PSet (2000 - 1000 * (Cos(i% * pi / 16) + Sin(i% * pi / 16) * Sin(pi / 4) / 2), _
      2000 + 1000 * Sin(pi / 4) * Sin(i% * pi / 16) / 2)
  Next i%
End function

Private Sub Test_Click()
Dim Dateiname As String, DateiNr As Integer
Dim Textausdatei, Text As String
Dim Counter As Double

Dateiname = "d:\Uebung.txt"
DateiNr = FreeFile 'FreeFile automatische Dateinummer für den Zugriff
Counter = 0
Open Dateiname For Input As DateiNr
  Do While Not EOF(DateiNr) 'Schleife bis ende der Datei
    Counter = Counter + 1
    Line Input #DateiNr, Textausdatei 'Zeilenweise lesen
      If Counter > 6000 And Counter < 8000 Then 'Zeilen auslesen
        Text = Textausdatei & Text
        MsgBox (Counter)
      End If
  Loop
  Close DateiNr
End Sub

12.3.2002

Function x(ByVal kanal As Integer) As Integer
  x = x0 - r * (Cos(kanal * pi / 16) + Sin(kanal * pi / 16) * Sin(pi / 4) / 2)
End Function

Function y(ByVal kanal As Integer) As Integer
  y = y0 + r * Sin(pi / 4) * Sin(kanal * pi / 16) / 2
End Function

Function ring_voll()
  For l% = -1 To 1 Step 2
  
  For i% = 0 To 31
    If i% = 31 Then
      k% = 0
    Else
      k% = i% + 1
    End If
    o% = (y(i%) - alt(i%)) - (y(k%) - alt(k%))
    u% = (y(i%) - y(k%))
    dx% = Abs(x(i%) - x(k%)) * l%
    
    If l% = -1 Then
      farbe% = 12
    Else
      farbe% = 11
    End If
    vor_o% = o% / Abs(o%)
    vor_u% = u% / Abs(u%)
    For j% = x(i%) To x(k%) Step l% * 15
       c% = j% - x(i%)
       Picture1.Line (x(i%), y(i%))-(x(k%), y(k%))
       Picture1.Line (x(i%), y(i%) - alt(i%))-(x(k%), y(k%) - alt(k%))
       Picture1.Line (x(i%), y(i%))-(x(i%), y(i%) - alt(i%))
       If (i%) Mod 4 = 0 Then
         Picture1.Line (x(i%), y(i%) - alt(i%))-(x(i%), 500 + l% * 150), QBColor(13)
         CurrentX = x(i%) - 7
         CurrentY = 150 + l% * 150
         Picture1.Print i%
       End If
       Picture1.Line (j%, (y(i%) - alt(i%)) - (c% / dx%) * o%) _
         -(j%, y(i%) - (c% / dx%) * u%), QBColor(farbe%)
      Next j%
  Next i%
  Next l%
End Function
icon 

back 2 top

Dim i As Long

Sub ShowProgress(Status As Control, AktDat As Long, AnzDat As Long)

Dim Proz As Integer

Proz = Int(AktDat / AnzDat * 100 + 0.5)
If (Proz < 0) Then Proz = 0
If (Proz > 100) Then Proz = 100

Status.Caption = String$(Int(Val(Status.Tag) / 100 * Proz + 0.5), "n")

End Sub
'Beispiel für den Aufruf

'Plazieren Sie ein gewöhnliches Label-Steuerelement auf die Form und setzen die Eigenschaft _
BorderStyle auf 1 - Fest Einfach. Wählen Sie als Schriftart (Font -Eigenschaft) Wingdings, _
9 fett. Im Eingabefeld für die Caption-Eigenschaft tippen Sie jetzt so viele n's ein, bis _
das Label-Element komplett mit den kleinen ausgefüllten Quadraten gefüllt ist. Die Anzahl _
der eingetippten n's tragen Sie in die Tag-Eigenschaft ein.

Private Sub Command1_Click()
For i = 1 To 100
ShowProgress Label1, i, 100
Next i
End Sub
 

Kawasaki-Händler in Dresden

links  back 2 top -- back 2 aktuell
allgemein
  http://www.vbwelt.de/index.html !!?
  http://www.visualbasic-archiv.de
  http://www.top219.org/vb/
  http://vb-tec.de
  http://www.tools4vb.de/
Forumeinträge
  http://www.visualbasic-archiv.de/forum/list.php?f=5
  http://141.76.22.55/~ar13/tud.cgi/Foren/Thread?id=7703240252&forum=3&topic=1675
---
  http://www.visualbasic-archiv.de/forum/read.php?f=3&i=8773&t=8771
vb-übersicht
  http://members.eunet.at/hweinberger/tutorials/vb-ubersicht.htm
excel-add-ins
  http://www.visualbasic-archiv.de/archiv/tipp_details.php3?pid=201
SMS
  http://www.ksk-hildesheim.de/061k00F6O.html