Microsoft Excel

Herbers Excel/VBA-Archiv

Tabelle mit Fenster


Betrifft: Tabelle mit Fenster
von: klausreich@web.de
Geschrieben am: 08.11.2018 16:08:34

Liebe Leute,

mein Tabellenblatt ist recht breit geworden. Die Zellen nach den Überschiften von A6 bis H500 und auch mehr sind eigentlich nur Eingangsdaten, über die ich nicht wirklich scrollen brauche. Die Auswertung hingegen steht fix in I1 - AK5. Um nun mühsames rechts-/links-scrollen zu vermeiden (und sehe dann die Informationen in B2/C2 nicht mehr), suche in eine Idee, den definierten Bereich I1 bis AK5 wie Windoofs das auch macht, quasi als Fenster auf Mausclick, Tastatur, ... mittig auf den aktuell sichtbaren Bildschirmbereich zu übertragen/überlagern und auch wieder löschen, also die ursprüngliche Wertetabelle, den ehemaligen Bildschrirm wieder herstellen könnte.

Klaus

@zwenn : solltest Du dies lesen, melde Dich doch bitte einmal bei mir. Nach einigen Tagen kann ich keine Rückfrage zu Deiner Lösung mehr stellen.

  

Betrifft: AW: Tabelle mit Fenster
von: Sepp
Geschrieben am: 08.11.2018 18:15:41

Hallo Klaus,

warum nicht einfach C6 markieren > Ansicht > Fenster fixieren ?


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Tabelle mit Fenster
von: klausreich@web.de
Geschrieben am: 08.11.2018 19:33:19

Danke Sepp,

das ist nicht das, was ich meinte. Guckst Du bitte das Bild ist ein wenig klein geraten, doch H. Herber mag's sonst nicht. Ich könnte leicht I1 bis AG5 nach ab A6 schieben. Das zerstört jedoch meine fein austarierten Spaltenbreiten A - H, was wohl das eigentliche Problem ist.

Gruß Klaus


  

Betrifft: AW: Tabelle mit Fenster
von: Sepp
Geschrieben am: 08.11.2018 20:16:10

Hallo Klaus,

in ein allgemeines Modul:

Modul Modul1

Option Explicit 
 
'? 2015 by Nepumuk - http://www.herber.de/forum/messages/1458287.html 
 
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32.dll" (ByRef _
  PicDesc As PICT_DESC, ByRef RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, ByRef _
  IPic As IPicture) As LongPtr 
Private Declare PtrSafe Function CopyImage Lib "user32.dll" (ByVal handle As LongPtr, _
  ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr 
Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal _
  wFormat As Long) As Long 
Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hwnd As LongPtr) As _
  Long 
Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) _
  As LongPtr 
Private Declare PtrSafe Function DeleteObject Lib "gdi32.dll" (ByVal hObject As LongPtr) _
  As Long 
Private Declare PtrSafe Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Any, ByRef _
  pCLSID As GUID) As Long 
Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long 
Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long 
 
Private Type GUID 
  Data1 As Long 
  Data2 As Integer 
  Data3 As Integer 
  Data4(0 To 7) As Byte 
End Type 
 
Private Type PICT_DESC 
  lSize As Long 
  lType As Long 
  hPic As LongPtr 
  hPal As LongPtr 
End Type 
 
Private Const PICTYPE_BITMAP As Long = 1 
Private Const CF_BITMAP As Long = 2 
Private Const IMAGE_BITMAP As Long = 0 
Private Const LR_COPYRETURNORG As Long = &H4 
Private Const GUID_IPICTUREDISP As String = "{7BF80981-BF32-101A-8BBB-00AA00300CAB}" 
 
Sub updateImage() 
  Dim objImage As Object 
  Dim rng As Range 
   
  On Error Resume Next 
  ActiveSheet.OLEObjects("myImage").Delete 
 
  Set rng = ActiveWindow.VisibleRange 
   
  Set objImage = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
    DisplayAsIcon:=False, Left:=0, Top:=0, Width:=0, Height:=0) 
   
  With objImage 
    .Name = "myImage" 
    .Object.Picture = showRange(Range("I1:AG5")) 
    .Object.AutoSize = True 
    .Left = rng.Left + rng.Width / 2 - .Width / 2 
    .Top = rng.Top + rng.Height / 2 - .Height / 2 
  End With 
 
  Set objImage = Nothing 
  Set rng = Nothing 
End Sub 
 
Sub deleteImage() 
  On Error Resume Next 
 
  ActiveSheet.OLEObjects("myImage").Delete 
End Sub 
 
 
Private Function PastePicture(ByRef prlngptrCopy As LongPtr) As IPictureDisp 
 
  Dim lngReturn As Long, lngptrPointer As LongPtr 
 
  If CBool(IsClipboardFormatAvailable(CF_BITMAP)) Then 
 
    lngReturn = OpenClipboard(CLngPtr(Application.hwnd)) 
 
    If lngReturn > 0 Then 
 
      lngptrPointer = GetClipboardData(CF_BITMAP) 
 
      prlngptrCopy = CopyImage(lngptrPointer, IMAGE_BITMAP, 0&, 0&, LR_COPYRETURNORG) 
 
      Call CloseClipboard 
 
      If lngptrPointer <> 0 Then Set PastePicture = CreatePicture(prlngptrCopy, 0) 
 
    End If 
  End If 
End Function 
 
Private Function CreatePicture(ByVal lngptrhPic As LongPtr, ByVal lngptrhPal As LongPtr) As IPictureDisp 
 
  Dim udtPicInfo As PICT_DESC, udtID_IDispatch As GUID 
  Dim objPicture As IPictureDisp 
 
  Call CLSIDFromString(StrPtr(GUID_IPICTUREDISP), udtID_IDispatch) 
 
  With udtPicInfo 
    .lSize = Len(udtPicInfo) 
    .lType = PICTYPE_BITMAP 
    .hPic = lngptrhPic 
    .hPal = lngptrhPal 
  End With 
 
  Call OleCreatePictureIndirect(udtPicInfo, udtID_IDispatch, 0&, objPicture) 
 
  Set CreatePicture = objPicture 
 
  Set objPicture = Nothing 
 
End Function 
 
Public Function showRange(ByRef Target As Range) As IPictureDisp 
 
  Static slngptrCopy As LongPtr 
 
  Call OpenClipboard(0&) 
  Call EmptyClipboard 
  Call CloseClipboard 
 
  If slngptrCopy <> 0 Then Call DeleteObject(slngptrCopy) 
 
  Target.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 
 
  Set showRange = PastePicture(slngptrCopy) 
 
  If showRange Is Nothing Then Call MsgBox("Unabel to show range as picture", vbCritical, "Error") 
 
End Function 
 
Private Function SaveClipboardImage(FileName As String) As Boolean 
  Dim lPicType As Long, oPic As Variant 
  lPicType = xlBitmap 
  Set oPic = PastePicture(lPicType) 
  If oPic Is Nothing Then Exit Function 
  SavePicture oPic, FileName 
  SaveClipboardImage = True 
End Function 
 
 


VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media

Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0





Mit 'updateImage' wird das Bild geladen, mit 'deleteImage' wieder gelöscht.


 ABCDEF
1Gruß Sepp
2
3



  

Betrifft: AW: Tabelle mit Fenster
von: klausreich@web.de
Geschrieben am: 08.11.2018 23:20:40

Good evening Sepp,

danke, aber schwere Kost, für einen Anfänger, wie mich, nicht mehr verdau- oder nachvollziebar. Ich melde mich wieder ... Derweil versuche ich eine andere Denke umzusetzen : den Berechnungs-Teil I1 - AG5 mit den erforderlichen Daten aus A1 - H5 in ein zweites Blatt zu bringen und einfach den Reiter zu wählen.

Danke und guts Nächtle, Klaus


  

Betrifft: Meld
von: Zwenn
Geschrieben am: 09.11.2018 14:39:19

Hallo Klaus,

was gibts denn?

Gruß,

Zwenn


  

Betrifft: AW: Meld
von: klausreich@web.de
Geschrieben am: 09.11.2018 20:37:02

Hi Zwenn, thanks für Deine Meldung !

Ich habe nun mit Deinen feinen Makros ohne Gobalstrahlung von proplanta und ohne SchnickSchnack ala "das Daten-Fenster überlagert das Berechnungs-Fenster" mit Meister Haude eine reproduzierbare Lösung gefunden, hänge jedoch an :

- Du hast es so eingerichtet, daß beim Löschen der Bereich von I6 bis Ende Tabelle, unten rechts gelöscht und geleert wird. Wenn Du das ändern würdest, könnte ich diesen Teil für Zu-Fuß-Rechnungen nutzen, die "erhalten" bleiben.
- Du bist wohl davon ausgegangen, daß ich auch einen neuen Zeitraum nachfordern könnte, der an den alten angefügt werden soll. Das ist nicht erforderlich.
- manches Mal - nicht immer, was ich aber nicht nachvollziehen kann - bleibt so die Zeile 6 leer
- um Platz in der Breite zu sparen löscht Du bitte die Spalte Ort ab A6, selbst A1, A2 "Wuppertal" könnten als Konstante hinterlegt sein
- ebenso könnten auch die Einheiten D5 (°C) bis H5 (m/s), platzsparend entfallen
- D1 bis E2 und deren Funtionen sind nicht erforderlich, statt dessen würde ich gerne die letzte belegte Zeilennummer wissen und würde die einfach als =ANZAHL2(A:A) noch irgendwo "reinquetschen"

Meine aktuellen, aber noch unfertigen Erkenntnisse ( da habe ich schon an Deinem Urprungscode "rumgefummelt" ) im Anhang http://www.herber.de/bbs/user/125300.xlsm

Nochmals Danke, Klaus



  

Betrifft: AW: Meld
von: Zwenn
Geschrieben am: 10.11.2018 00:46:01

Hallo Klaus,

das muss ich mir mal in Ruhe anschauen. Die Ortsspalte hatte ich damals mit eingebaut, als ich noch nicht wußte, dass Du immer den gleichen Ort benötigst. So gesehen ist das nur ein Überbleibsel, das man mit ein paar Anpassungen sicher vollständig aus der Tabelle entfernen kann.

Deine sonstigen Ausführungen versuche ich nachzuvollziehen, wenn ich in Ruhe einen Blick auf die Datei werfe. Kann aber ein paar Tage dauern, da ich nun erstmal etwas für Bernd fertig mache. War die letzten zwei Wochen durch eine hartnäckige Erkältung ausgebremst.

Sehe grade, dass man die Einheiten in der Kopfzeile auch alle wegnehmen kann. Die Spalten sind ja so formatiert, dass jeder Wert mit Einheit versehen ist. Das kannst Du aber auch schon selbst machen, wenn Du mehr Breite brauchst. Die Kopfzeilen und Spaltenformate werden nicht vom Makro benötigt oder beeinflusst. Mit einer etwas kleineren Schriftgröße kann man sich auch etwas mehr Platz verschaffen, solange man noch alles bequem lesen kann.

Scrollgrenzenwahl und Farbwechsel kann ich auch wieder rausnehmen. Das hatte ich nur eingebaut, weil ich nicht sicher war, ob Du das nun brauchst oder nicht. Was sind denn Deine festen Parameter für die dann entfallenen Funktionen? So wie jetzt in der hochgeladenen Datei gesetzt? Verdrahte ich dann einfach fest, dann ist Platz für die Ausweisung der aktuell letzten Zeilenzahl.

Zu ...
Du bist wohl davon ausgegangen, daß ich auch einen neuen Zeitraum nachfordern könnte, der an den alten angefügt werden soll. Das ist nicht erforderlich.
... habe ich ehrlich gesagt keine Idee, was Du damit für einen Änderungswunsch hast. Wenn Du wieder auf Auslesen klickst, werden neue Zeilen halt hinten angefügt. Das ist doch aber kein Nachteil. Oder was meinst Du?

Wann tritt das Ereignis, dass Zeile 6 leer bleibt ein? Wenn Du zuvor die Daten über den Button gelöscht hast? Das hat dann was mit der Löschen Funktion zu tun. Aber die schaue ich mir dann eh nochmal an, damit Du Deine Inhalte ab Spalte I dann behältst.

So, habe jetzt doch schon mehr nachgeschaut, als erst gewollt ;-) Aber die Umsetzung dauert dann wirklich ein paar Tage. Deine Antworten auf meine Fragen oder Reaktionen auf meinen Anmerkungen wären hilfreich.

Viele Grüße,

Zwenn


  

Betrifft: AW: Meld
von: klausreich@web.de
Geschrieben am: 10.11.2018 13:29:39

Guten Mittag Zwenn, laß Dir Zeit. Erst Bernd, dann ich. Langsam verstehe ich Deine Denke immer besser und kann nach Internet-Recherche, wie heißt der Befehl, wenn ich ... brauche ?, auch eigene Anpassungen vornehmen. Z.B. Löschen : statt Range(Rows(ersteZeile), Rows(letzteZeile)).Delete nun Range("A6:H" & letzteZeile).ClearContents, was H1 ... AF5 bzw. AF unendlich nicht mehr zerstört. Was sich mir noch nicht erschlossen hat ist 'Nächsten Schleifendurchlauf vorbereiten. Das könnte dazu führen, daß nach Löschen und neu Einlesen mal die Zeile 6, mal die ersten 35 Zeilen leer bleiben ? Durch die Formel von Haude muß ich immer einen definierten Zeitraum betrachten; so muß auch der "Formelteil" zwischen I1 und AF5 nach dem Löschen erhalten bleiben, neu angefügte Zeilen bringen die ganze Logik der tages- und monatsbezogenen Parameter Haude durcheinander. Ich wurschtel mich da schon durch. Schön wäre, wenn Du spontan eine Idee hättest, die festen 5000 aus =SUMMEWENN(C6:C5000;"12:00";D6:D5000) auf letzte belegte belegte Zeile Anzahl2 zu setzen. Oder macht's keinen Sinn, weil Summe bis 100 oder bis 65000 nur ein halbe Sekunde mehr braucht ? Sorry, daß ich Dir Deine Zeit stehle. Mir würde es schon helfen, wenn ich bei Gelegenheit und Null Durchblick noch ein Mal nachfragen dürfte. Nice WE, Klaus