Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro automatisieren

Forumthread: Makro automatisieren

Makro automatisieren
25.12.2018 17:17:14
Richard
Liebe Excelgemeinde,
es wäre nett wenn mir jemand eine Unterstützung gibt.
Folgender Ablauf: in einer LstBox werden Daten angeklickt und auf ein Tabellenblatt geschrieben _ Code

Private Sub cmb_Auswahlkatallog_Click()
Dim wks As Worksheet
Dim lngI As Long
Dim lngZ As Long
Dim intS As Integer
Dim intI As Integer
Set wks = Worksheets("Katallog")
lngZ = 2
wks.Range("A2:M100" & wks.Range("A65536").End(xlUp).Row).ClearContents
With Me.ListBox1
For lngI = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(lngI) Then
intI = 0
For intS = 0 To 8  'Anzahl Spalte =9
Select Case intS
Case 0, 2, 4, 6, 7    '0=a,1=B usw
intI = intI + 1
wks.Cells(lngZ, intI) = .List(lngI, intS)
Case Else
End Select
Next
lngZ = lngZ + 1
End If
Next
End With
End Sub

bei wechsel auf den Sheet werden die daten angezeigt Code

Private Sub cmdBeenden_Click()
Erase arrList, arrData
Set wksData = Nothing
Unload Me
Sheets("Katallog").Select
End Sub

Dies funktioniert einwandfrei ich möchte jedoch die nachfolgenden Makros (stehen im Sheet automatisch bei Wechsel ablaufen lassen d.h. Bilder einfügen und Rahmen setzen, beim Verlassen Bilder löschen und Rahmen entfernen.
mit Button geht dies alles einwandfrei
Diese Makros sollen automatisch ablaufen
Sub Bilder_einfügen_2()
Dim Pfad As String
Dim strDatnam As String
Dim Wiederholungen As Long
Dim Bildbreite As Single
Dim Bildhöhe As Single
Dim meinBild
Dim maxSpaltenbreite As Single
Dim Bild As Shape
Dim Zelle As Range
'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False
'Pfad angeben
Pfad = "C:\Bildeinfügen\ArtNr\"
'Spalte A ab Zeile 2 durchlaufen
For Wiederholungen = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
'Namen der Bilder stehen in Spalte 4 - ohne Endung; Einlesen in Variable mit Pfadangaben
strDatnam = Pfad & Cells(Wiederholungen, 4).Value & ".jpg"
'Prüfen, ob Bilddatei im Verzeichnis existiert
If Dir(strDatnam) "" Then
'falls ja, dann Bildhöhe und -breite einlesen
Set meinBild = LoadPicture(strDatnam)
Bildbreite = meinBild.Width
Bildhöhe = meinBild.Height
'Bild einfügen, 9 cm hoch - 1 cm = 28,35 pt - und Breite entsprechend skaliert
ActiveSheet.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Cells(Wiederholungen, 6).Left, _
Cells(Wiederholungen, 6).Top, 100 * Bildbreite / Bildhöhe, 100
'maximale Spaltenbreite ermitteln, für die Anpassung der Spaltenbreite
If maxSpaltenbreite Bildbreite / Bildhöhe
Else
'falls nein, wird in Spalte F eine Fehlermeldung geschrieben
ActiveSheet.Cells(Wiederholungen, 6) = "Bild nicht gefunden-nicht angelegt"
End If
Next
'Zeilenhöhe anpassen
Rows("2:" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row).RowHeight = 105
'Spaltenbreite anpassen
Columns("F:F").ColumnWidth = (WorksheetFunction.RoundUp(maxSpaltenbreite / 5, 0) + 2)
'Alle Bilder im Blatt in Zelle zentrieren
For Each Bild In ActiveSheet.Shapes
With Bild.TopLeftCell
Set Zelle = Cells(.Row, .Column)
End With
Bild.Top = Zelle.Top + (Zelle.Height - Bild.Height) / 2
Bild.Left = Zelle.Left + (Zelle.Width - Bild.Width) / 2
Next
'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True
End Sub
Sub Bilderloeschen_Click()
Const cBereich = "F2:F10"
Dim shp As Object
For Each shp In Tabelle5.Shapes
If Not Intersect(Tabelle5.Range(cBereich), shp.TopLeftCell) Is Nothing Then shp.Delete
Next shp
Range("F2:F10").ClearContents
End Sub

Private Sub cmbRahmenentfernen_Click()
Dim rBereich As Range
Dim rZelle As Range
' ThisWorkbook.Worksheets("Tabelle5").Activate
Set rBereich = Range("A2:F10")
Application.ScreenUpdating = False
For Each rZelle In rBereich
If Trim$(rZelle) "" Then
rZelle.Borders.LineStyle = xlNone ' alle Linien löschen
End If
Next rZelle
End Sub

Sub Rahmenerstellen_Click()
'Sub Rahmen_erstellen()
Dim rBereich As Range
Dim rZelle As Range
' ThisWorkbook.Worksheets("Tabelle5").Activate
Set rBereich = Range("A2:F10")
Application.ScreenUpdating = False
For Each rZelle In rBereich
If Trim$(rZelle) "" Then
rZelle.BorderAround xlContinuous, xlMedium
Else
rZelle.Borders.LineStyle = xlNone ' alle Linien löschen
End If
Next rZelle
End Sub Vielen Dank schon einmal im Voraus für Eure Hilfe
Gruß Richard
Anzeige

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro automatisieren
25.12.2018 17:33:06
Sepp
Hallo Richard,
in das Modul der entsprechenden Tabelle - ungetestet!
Microsoft Excel Objekt Tabelle1
Option Explicit 
 
Private Sub Worksheet_Activate() 
  Dim Pfad As String 
  Dim strDatnam As String 
  Dim Wiederholungen As Long 
  Dim Bildbreite As Single 
  Dim Bildhöhe As Single 
  Dim maxSpaltenbreite As Single 
  Dim Bild As Shape 
  Dim Zelle As Range 
 
  On Error GoTo ErrorHandler 
  'Bildschirmaktualisierung ausschalten: 
  Application.ScreenUpdating = False 
 
  'Pfad angeben 
  Pfad = "C:\Bildeinfügen\ArtNr\" 
  'Spalte A ab Zeile 2 durchlaufen 
  For Wiederholungen = 2 To Me.Cells(Me.Rows.Count, 1).End(xlUp).Row 
    'Namen der Bilder stehen in Spalte 4 - ohne Endung; Einlesen in Variable mit Pfadangaben 
    strDatnam = Pfad & Cells(Wiederholungen, 4).Value & ".jpg" 
    'Prüfen, ob Bilddatei im Verzeichnis existiert 
    If Dir(strDatnam) <> "" Then 
      'falls ja, dann Bildhöhe und -breite einlesen 
      Set meinBild = LoadPicture(strDatnam) 
      Bildbreite = meinBild.Width 
      Bildhöhe = meinBild.Height 
 
      'Bild einfügen, 9 cm hoch - 1 cm = 28,35 pt - und Breite entsprechend skaliert 
      Me.Shapes.AddPicture strDatnam, msoFalse, msoTrue, Me.Cells(Wiederholungen, 6).Left, _
        Me.Cells(Wiederholungen, 6).Top, 100 * Bildbreite / Bildhöhe, 100 
      'maximale Spaltenbreite ermitteln, für die Anpassung der Spaltenbreite 
      If maxSpaltenbreite < 100 * Bildbreite / Bildhöhe Then maxSpaltenbreite = 100 * _
        Bildbreite / Bildhöhe 
    Else 
      'falls nein, wird in Spalte F eine Fehlermeldung geschrieben 
      Me.Cells(Wiederholungen, 6) = "Bild nicht gefunden-nicht angelegt" 
    End If 
  Next 
 
  'Zeilenhöhe anpassen 
  Me.Rows("2:" & Me.Cells(Me.Rows.Count, 2).End(xlUp).Row).RowHeight = 105 
 
  'Spaltenbreite anpassen 
  Me.Columns("F:F").ColumnWidth = (WorksheetFunction.RoundUp(maxSpaltenbreite / 5, 0) + 2) 
 
  'Alle Bilder im Blatt in Zelle zentrieren 
  For Each Bild In Me.Shapes 
    With Bild.TopLeftCell 
      Set Zelle = Me.Cells(.Row, .Column) 
    End With 
    Bild.Top = Zelle.Top + (Zelle.Height - Bild.Height) / 2 
    Bild.Left = Zelle.Left + (Zelle.Width - Bild.Width) / 2 
  Next 
 
  For Each Zelle In Me.Range("A2:F10") 
    If Trim$(Zelle) <> "" Then 
      Zelle.BorderAround xlContinuous, xlMedium 
    Else 
      Zelle.Borders.LineStyle = xlNone ' alle Linien löschen 
    End If 
  Next 
ErrorHandler: 
  'Bildschirmaktualisierung einschalten: 
  Application.ScreenUpdating = True 
End Sub 
 
Private Sub Worksheet_Deactivate() 
  Const cBereich = "F2:F10" 
  Dim shp As Object, Zelle As Range 
 
  On Error GoTo ErrorHandler 
  'Bildschirmaktualisierung ausschalten: 
  Application.ScreenUpdating = False 
   
  For Each shp In Me.Shapes 
    If Not Intersect(Me.Range(cBereich), shp.TopLeftCell) Is Nothing Then shp.Delete 
  Next shp 
   
  Me.Range(cBereich).ClearContents 
   
  For Each Zelle In Me.Range(cBereich) 
    If Trim$(Zelle) <> "" Then 
      Zelle.Borders.LineStyle = xlNone ' alle Linien löschen 
    End If 
  Next 
   
ErrorHandler: 
  'Bildschirmaktualisierung einschalten: 
  Application.ScreenUpdating = True 
End Sub 

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


 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Makro automatisieren
25.12.2018 18:04:59
Richard
Hallo Sepp,
vielen Dank funktioniert alles einwandfrei,eine Frage noch dazu
habe es in den Makros der UF probiert mit Call Sheets("Tabelle").Name Sub warum geht es so nicht?
Gruß Richard
AW: Makro automatisieren
25.12.2018 18:30:02
Sepp
Hallo Richard,
das sind Ereignis-Prozeduren, sie werden beim Aktivieren, bzw. Deaktivieren der Tabelle aufgerufen, die brauchst/kannst du nicht separat aufrufen.
 ABCDEF
1Gruß Sepp
2
3

Anzeige
AW: Makro automatisieren
25.12.2018 18:33:18
Richard
Hallo Sepp,
vielen Dank noch einmal und für den Rest der Feiertage noch etwas Ruhe und Erholung
Gruß Richard
Falls du wirklich versucht hast, ...
25.12.2018 20:47:13
Luc:-?
Richard (& Sepp),
die so aufzurufen: Call Sheets("Tabelle").Name Sub,
kannst du dir deine Frage leicht selbst beantworten, denn das ist kein gültiger Aufruf, liegt also außerhalb der VBA-Syntax. Das wäre dann auch der HptGrund des AufrufVersagens. Falls du das nur ungünstig dargestellt hast, träfen andere Gründe zu:
1. EreignisProzeduren wdn standardmäßig stets in einem (hier Dokument-)KlassenModul und als Private deklariert und stellen damit eine seiner Eigenschaften dar. Wäre die Prozedur nicht Private, sondern Public, könnte sie auch aus einem anderen Modul mit voran­ge­stelltem ModulNamen aufgerufen wdn, also: Call Sheets("Tabelle").Worksheet_Activate
2. EreignisProzeduren sollen, wie schon der Name sagt, auf ein Ereignis reagieren und wdn somit durch Eintritt des in ihrem Namen genannten Ereignisses ausgelöst. Das ist Teil von Möglichkeiten zur ProzessAutomatisierung. Ein anderweitiger Aufruf einer solchen Pro­zedur ist deshalb nur in AusnahmeFällen erforderlich.
3. Man kann eine EreignisProzedur auf 3erlei Weise (per Pgm) auslösen:
3.1 Man lässt das Ereignis eintreten (der übliche Weg).
3.2 Man legt in ihrem Klassenmodul eine Public-Prozedur an, die sie aufruft; diese kann man dann von außerhalb aufrufen.
3.3 Man ändert direkt ihre Aufrufbarkeit von nur Private auf Public, was möglich ist, von mir aber nicht empfohlen wird.
Merke: Eine Public-Prozedur ist im ganzen Projekt sicht- und aufrufbar, eine Private nur in ihrem Modul.
Wenn man eine parametrierte Prozedur aufruft (die hier verwendete EreignisProzedur hat keine Parameter), muss man ihr auch die in ihrem Kopf ggf deklarierten Parameter übergeben, sofern diese nicht Optional sind (ein ParamArray ist immer optional). Ein eintre­ten­des Ereignis stellt diese einer zugehörigen Prozedur automatisch zV, ein separater Aufruf nicht per sé.
Gruß+FroWeihn, Luc :-?
Anzeige
AW: Falls du wirklich versucht hast, ...
26.12.2018 12:21:33
Richard
Hallo Luc,
vielen Dank für Deine ausführliche Beschreibung ist sehr verständlich
Gruß Richard
Bitte sehr, gern geschehen! ;-) owT
26.12.2018 15:31:40
Luc:-?
:-?
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige